emacs-19_28/cpp/ 755 23 204 0 6027033065 6426 emacs-19_28/etc/ 755 23 204 0 6027033031 6410 emacs-19_28/info/ 755 23 204 0 6027033053 6574 emacs-19_28/lib-src/ 755 23 204 0 6027033002 7166 emacs-19_28/lisp/ 755 23 204 0 5761501354 6620 emacs-19_28/lock/ 755 23 204 0 6027034100 6563 emacs-19_28/lwlib/ 755 23 204 0 6027033107 6752 emacs-19_28/man/ 755 23 204 0 6027033133 6413 emacs-19_28/msdos/ 755 23 204 0 6027033217 6770 emacs-19_28/oldxmenu/ 755 23 204 0 6027033161 7474 emacs-19_28/shortnames/ 755 23 204 0 6027033223 10023 emacs-19_28/site-lisp/ 755 23 204 0 6027034101 7545 emacs-19_28/src/ 755 23 204 0 5761501356 6442 emacs-19_28/vms/ 755 23 204 0 6002671321 6445 emacs-19_28/lisp/$changelog$.txt 644 23 204 15717 6027634703 11541 Tue Sep 19 21:21:58 1995 Richard Levitte * shell.el (shell-directory-tracker): [VMS] now correctly checks for `set default'. (shell-prefixed-directory-name): [VMS] checks if the given directory specification is a logical name only, and in that case, uses the value as directory spec. * files.el (cd): [VMS] does not prepend the directory spec with `./' Sun Sep 10 00:26:13 1995 Richard Levitte * dired-vmsaux.el (dired-remove-entry): new version of old function, to remove both lines of 2-line file spec. Sat Feb 25 11:16:09 1995 Richard Levitte (LEVITTE@eliza.e.kth.se) * vms-date.el (vms-patch-date): changed the date to today. Fri Nov 25 13:56:20 1994 Richard Levitte (LEVITTE@eliza.e.kth.se) * info.el (Info-directory-list) [VMS]: use "," instead of ":" as path separator. * server.el: add a hook to send the Abort command to the server process and to delete sys$scratch:.emacs_server when Emacs is killed. Thu Oct 27 13:21:07 1994 Richard Levitte (LEVITTE@eliza.e.kth.se) * vms-pmail.el (insert-signature): changed (end-of-buffer) to (goto-char (point-max)). Fri Aug 5 15:01:52 1994 Richard Levitte (LEVITTE@elmer.e.kth.se) * files.el (find-file-expand-completelly): New variable. (file-truename-wrap): New function, which makes use of find-file-expand-completelly. (find-file-noselect, set-visited-file-name): Makes use of file-truename-wrap instead of file-truename. (insert-directory): Uses call-process directly instead of calling vms-read-directory. * gnus.el (gnus-read-newsrc-file, gnus-save-newsrc-file): Hopefully formats the directory part of the file a little better. * mail-utils.el (mail-strip-quotes-names): Now leaves names like FOO::"bar" alone. * pascal.el: Corrected typo. * vms-patch.el (file-truename): Now takes an extra optional argument. (backup-file-name-p): New function. Really silly, but it is there to keep dired running. (backup-extract-version): New function. Extracts the version number of a file. (find-backup-file-name): New function. Needed by dired. (old-write-region): Now only set if not previously set, to avoid endless loops if vms-patch is reloaded. (auto-save-file-name-p): Changed to work correctly on auto save files like _$FOO$.;12. (vms-command-line-again): Changed to remove "-MAP", "-NW", "-BATCH" and "-T" from the command line if present. (vms-read-directory): Removed. Sat May 21 22:09:01 1994 Richard Levitte (LEVITTE@elmer.e.kth.se) * loadup.el: Now loads vms-date.el. * startup.el: Takes advantage of vms-patch-date. * vms-date.el: New file. Contains the date of creation of the current VMS patch. * vms-patch.el(vms-suspend-resume-hook): Calls vms-command-line-again with the argument string as argument. * vms-patch.el(vms-command-line-again): Now takes an argument, instead of looking at the logical name EMACS_COMMAND_ARGS. Also, does not convert 8-bit printable chars to space any more. And last, calls command-line-1, after fooling Emacs with a couple of variables, so Emacs won't do all the startup stuff, just the command line processing. Fri May 20 14:01:45 1994 Richard Levitte (LEVITTE@elmer.e.kth.se) * rmail.el(rmail-make-in-reply-to-field): changed to not treat addresses of the form FOO::BAR as an RFC822 address. * vms-patch.el(make-auto-save-file-name): changed to use the version numbers instead of producing a bogus file name. * vms-patch.el(auto-save-file-name-p): Change to succeed even if the file name has a version number. * vms-patch.el(dired-listing-switches): is less complicated now. * vms-sndmail.el(vms-sendmail-temp-dir, vms-sendmail-function, vms-default-sendmail-method): New variables and function to allow the user to specify different ways of sending mail. Sun Mar 20 18:49:07 1994 Richard Levitte (LEVITTE@eliza.e.kth.se) * autoload.el: Downcase file names so there will be no confusion. * diff.el: On VMS, use the VMS command `difference'. * dired-vms.el: Inserted all the changes from Mark London. * dired.el(dired-trivial-filenames, dired-copy-preserve-time): should be nil on VMS. * dired.el(dired-subdir-regexp): Needed a different definition for VMS. * files.el(basic-save-buffer): Precious files use `$' instead of `#' on VMS. * files.el(list-directory): There is no need to type the word "Directory" on VMS, as the DIRECTORY command does it by itself. * loadup.el: Changed so it would not make a DOC file if not needed. * lpr.el: Added the sitch lpr-header-=switch, and addapted the code to VMS. * mail-utils.el(mail-strip-quoted-names): Changed to leave addresses with the VMS wrapping for a different transport alone. * mail-utils.el(vms-mail-remove-transport): New function. Strips the VMS transport wrapping from a mail address. * rmail.el: Changed to work on VMS also. * rmailsum.el: Changed to work on VMS also. * shell.el: Changed to work better on VMS. * vms-patch.el(file-newest-backup): Added function, to replace the one in files.el. * vms-patch.el(vms-read-directory): Changed to use call-process instead of the obsolete subprocess-command-to-buffer. Also, use search-forward in such a way that we don't get stupid errors. * vms-patch.el(lpr-command, lpr-header-switch, print-region-function): Changed to reall work. Tue Jan 18 22:45:39 1994 Richard Levitte (LEVITTE@eliza.e.kth.se) * dired.el: Changed a few settings for VMS. * files.el: Changed the settings of the different list-directory switches for VMS, as well as the directory command to use. * info.el: Added `::' to menu items that represent other DIR files. Fri Jul 30 12:42:11 1993 Richard Levitte (LEVITTE@elin.e.kth.se) * comint.el (comint-exec-1): Small change for VMS. * files.el (make-directory): Small change for VMS. * gnus.el: gnus-nntp-service is set to 119 on VMS. * gnus.el (gnus-{Numeric,numeric,Plain,plain}-save-name): Changed to make legal VMS directories and file names. * gnus.el (gnus-make-directory): Changed to use make-directory. Is there a reason this still exists? gnus-make-directory-1 is commented out. * gnus.el (gnus-make-newsrc-file): Changed to make a legal file name on VMS. * gnus.el (gnus-save-newsrc-file): Changed to not make backups on VMS, and to use the Stream_LF file format. * paths.el: Changed the definition of gnus-nntp-service as in gnus.el. * term/x-win.el: Changed for VMS to use DECW$DISPLAY instead of DISPLAY. * vms-patch.el (make-legal-file-name): Now takes an optional argument which defines how dots in filenames are treated. * vms-patch.el (file-truename): New function which replaces the one defined in files.el. * vms-patch.el (write-region): Wrapper around the original write-region to find the right place to write the file. This is related to VMS search paths. * vms-patch.el (vms-suspend-resume-hook): Small fix. Also a small change to use add-hook instead of setq. * vms-patch.el: Added some code to make send-mail-function designate a VMS specific function. * vms-sndmai.el: New file to implement send-mail-send-it on VMS. s-patch.el (file-truename): New function which reemacs-19_28/lisp/files.el 644 23 204 257201 6027634703 10401 ;;; files.el --- file input and output commands for Emacs ;; Copyright (C) 1985, 86, 87, 92, 93, 94 Free Software Foundation, Inc. ;; Maintainer: FSF ;; This file is part of GNU Emacs. ;; GNU Emacs 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 2, or (at your option) ;; any later version. ;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Defines most of Emacs's file- and directory-handling functions, ;; including basic file visiting, backup generation, link handling, ;; ITS-id version control, load- and write-hook handling, and the like. ;;; Code: (defconst delete-auto-save-files t "*Non-nil means delete auto-save file when a buffer is saved or killed.") (defconst directory-abbrev-alist nil "*Alist of abbreviations for file directories. A list of elements of the form (FROM . TO), each meaning to replace FROM with TO when it appears in a directory name. This replacement is done when setting up the default directory of a newly visited file. *Every* FROM string should start with `^'. Do not use `~' in the TO strings. They should be ordinary absolute directory names. Use this feature when you have directories which you normally refer to via absolute symbolic links. Make TO the name of the link, and FROM the name it is linked to.") ;;; Turn off backup files on VMS since it has version numbers. (defconst make-backup-files (not (eq system-type 'vax-vms)) "*Non-nil means make a backup of a file the first time it is saved. This can be done by renaming the file or by copying. Renaming means that Emacs renames the existing file so that it is a backup file, then writes the buffer into a new file. Any other names that the old file had will now refer to the backup file. The new file is owned by you and its group is defaulted. Copying means that Emacs copies the existing file into the backup file, then writes the buffer on top of the existing file. Any other names that the old file had will now refer to the new (edited) file. The file's owner and group are unchanged. The choice of renaming or copying is controlled by the variables `backup-by-copying', `backup-by-copying-when-linked' and `backup-by-copying-when-mismatch'. See also `backup-inhibited'.") ;; Do this so that local variables based on the file name ;; are not overridden by the major mode. (defvar backup-inhibited nil "Non-nil means don't make a backup, regardless of the other parameters. This variable is intended for use by making it local to a buffer. But it is local only if you make it local.") (put 'backup-inhibited 'permanent-local t) (defconst backup-by-copying nil "*Non-nil means always use copying to create backup files. See documentation of variable `make-backup-files'.") (defconst backup-by-copying-when-linked nil "*Non-nil means use copying to create backups for files with multiple names. This causes the alternate names to refer to the latest version as edited. This variable is relevant only if `backup-by-copying' is nil.") (defconst backup-by-copying-when-mismatch nil "*Non-nil means create backups by copying if this preserves owner or group. Renaming may still be used (subject to control of other variables) when it would not result in changing the owner or group of the file; that is, for files which are owned by you and whose group matches the default for a new file created there by you. This variable is relevant only if `backup-by-copying' is nil.") (defvar backup-enable-predicate '(lambda (name) (or (< (length name) 5) (not (string-equal "/tmp/" (substring name 0 5))))) "Predicate that looks at a file name and decides whether to make backups. Called with an absolute file name as argument, it returns t to enable backup.") (defconst buffer-offer-save nil "*Non-nil in a buffer means offer to save the buffer on exit even if the buffer is not visiting a file. Automatically local in all buffers.") (make-variable-buffer-local 'buffer-offer-save) (defconst find-file-existing-other-name nil "*Non-nil means find a file under alternative names, in existing buffers. This means if any existing buffer is visiting the file you want under another name, you get the existing buffer instead of a new buffer.") (defconst find-file-visit-truename nil "*Non-nil means visit a file under its truename. The truename of a file is found by chasing all links both at the file level and at the levels of the containing directories.") (defvar buffer-file-truename nil "The abbreviated truename of the file visited in the current buffer. That is, (abbreviated-file-name (file-truename buffer-file-name)). This variable is automatically local in all buffers, when non-nil.") (make-variable-buffer-local 'buffer-file-truename) (put 'buffer-file-truename 'permanent-local t) (defvar buffer-file-number nil "The device number and file number of the file visited in the current buffer. The value is a list of the form (FILENUM DEVNUM). This pair of numbers uniquely identifies the file. If the buffer is visiting a new file, the value is nil.") (make-variable-buffer-local 'buffer-file-number) (put 'buffer-file-number 'permanent-local t) (defconst file-precious-flag nil "*Non-nil means protect against I/O errors while saving files. Some modes set this non-nil in particular buffers.") (defvar version-control nil "*Control use of version numbers for backup files. t means make numeric backup versions unconditionally. nil means make them for files that have some already. `never' means do not make them.") (defvar dired-kept-versions 2 "*When cleaning directory, number of versions to keep.") (defvar delete-old-versions nil "*If t, delete excess backup versions silently. If nil, ask confirmation. Any other value prevents any trimming.") (defvar kept-old-versions 2 "*Number of oldest versions to keep when a new numbered backup is made.") (defvar kept-new-versions 2 "*Number of newest versions to keep when a new numbered backup is made. Includes the new backup. Must be > 0") (defconst require-final-newline nil "*Value of t says silently ensure a file ends in a newline when it is saved. Non-nil but not t says ask user whether to add a newline when there isn't one. nil means don't add newlines.") (defconst auto-save-default t "*Non-nil says by default do auto-saving of every file-visiting buffer.") (defconst auto-save-visited-file-name nil "*Non-nil says auto-save a buffer in the file it is visiting, when practical. Normally auto-save files are written under other names.") (defconst save-abbrevs nil "*Non-nil means save word abbrevs too when files are saved. Loading an abbrev file sets this to t.") (defconst find-file-run-dired t "*Non-nil says run dired if `find-file' is given the name of a directory.") ;;;It is not useful to make this a local variable. ;;;(put 'find-file-not-found-hooks 'permanent-local t) (defvar find-file-not-found-hooks nil "List of functions to be called for `find-file' on nonexistent file. These functions are called as soon as the error is detected. `buffer-file-name' is already set up. The functions are called in the order given until one of them returns non-nil.") ;;;It is not useful to make this a local variable. ;;;(put 'find-file-hooks 'permanent-local t) (defvar find-file-hooks nil "List of functions to be called after a buffer is loaded from a file. The buffer's local variables (if any) will have been processed before the functions are called.") (defvar write-file-hooks nil "List of functions to be called before writing out a buffer to a file. If one of them returns non-nil, the file is considered already written and the rest are not called. These hooks are considered to pertain to the visited file. So this list is cleared if you change the visited file name. See also `write-contents-hooks'. Don't make this variable buffer-local; instead, use `local-write-file-hooks'.") ;;; However, in case someone does make it local... (put 'write-file-hooks 'permanent-local t) (defvar local-write-file-hooks nil "Just like `write-file-hooks', except intended for per-buffer use. The functions in this list are called before the ones in `write-file-hooks'.") (make-variable-buffer-local 'local-write-file-hooks) (put 'local-write-file-hooks 'permanent-local t) (defvar write-contents-hooks nil "List of functions to be called before writing out a buffer to a file. If one of them returns non-nil, the file is considered already written and the rest are not called. These hooks are considered to pertain to the buffer's contents, not to the particular visited file; thus, `set-visited-file-name' does not clear this variable, but changing the major mode does clear it. See also `write-file-hooks'.") (defconst enable-local-variables t "*Control use of local-variables lists in files you visit. The value can be t, nil or something else. A value of t means local-variables lists are obeyed; nil means they are ignored; anything else means query. The command \\[normal-mode] always obeys local-variables lists and ignores this variable.") (defconst enable-local-eval 'maybe "*Control processing of the \"variable\" `eval' in a file's local variables. The value can be t, nil or something else. A value of t means obey `eval' variables; nil means ignore them; anything else means query. The command \\[normal-mode] always obeys local-variables lists and ignores this variable.") ;; Avoid losing in versions where CLASH_DETECTION is disabled. (or (fboundp 'lock-buffer) (defalias 'lock-buffer 'ignore)) (or (fboundp 'unlock-buffer) (defalias 'unlock-buffer 'ignore)) ;; This hook function provides support for ange-ftp host name ;; completion. It runs the usual ange-ftp hook, but only for ;; completion operations. Having this here avoids the need ;; to load ange-ftp when it's not really in use. (defun ange-ftp-completion-hook-function (op &rest args) (if (memq op '(file-name-completion file-name-all-completions)) (apply 'ange-ftp-hook-function op args) (let ((inhibit-file-name-handlers (cons 'ange-ftp-completion-hook-function (and (eq inhibit-file-name-operation op) inhibit-file-name-handlers))) (inhibit-file-name-operation op)) (apply op args)))) (defun pwd () "Show the current default directory." (interactive nil) (message "Directory %s" default-directory)) (defvar cd-path nil "Value of the CDPATH environment variable, as a list. Not actually set up until the first time you you use it.") (defun parse-colon-path (cd-path) "Explode a colon-separated list of paths into a string list." (and cd-path (let (cd-prefix cd-list (cd-start 0) cd-colon) (setq cd-path (concat cd-path ":")) (while (setq cd-colon (string-match ":" cd-path cd-start)) (setq cd-list (nconc cd-list (list (if (= cd-start cd-colon) nil (substitute-in-file-name (file-name-as-directory (substring cd-path cd-start cd-colon))))))) (setq cd-start (+ cd-colon 1))) cd-list))) (defun cd-absolute (dir) "Change current directory to given absolute file name DIR." ;; Put the name into directory syntax now, ;; because otherwise expand-file-name may give some bad results. (if (not (eq system-type 'vax-vms)) (setq dir (file-name-as-directory dir))) (setq dir (abbreviate-file-name (expand-file-name dir))) (if (not (file-directory-p dir)) (error "%s is not a directory" dir) (if (file-executable-p dir) (setq default-directory dir) (error "Cannot cd to %s: Permission denied" dir)))) (defun cd (dir) "Make DIR become the current buffer's default directory. If your environment includes a `CDPATH' variable, try each one of that colon-separated list of directories when resolving a relative directory name." (interactive "FChange default directory: ") (if (file-name-absolute-p dir) (cd-absolute (expand-file-name dir)) (if (null cd-path) (let ((trypath (parse-colon-path (getenv "CDPATH")))) (setq cd-path (or trypath (if (not (memq system-type '(vax-vms axp-vms))) (list "./")))))) (if (not (catch 'found (mapcar (function (lambda (x) (let ((f (expand-file-name (concat x dir)))) (if (file-directory-p f) (progn (cd-absolute f) (throw 'found t)))))) cd-path) (if (memq system-type '(vax-vms axp-vms)) (let ((f (expand-file-name (file-name-as-directory dir)))) (if (file-directory-p f) (progn (cd-absolute f) (throw 'found t)))) nil))) (error "No such directory found via CDPATH environment variable")))) (defun load-file (file) "Load the Lisp file named FILE." (interactive "fLoad file: ") (load (expand-file-name file) nil nil t)) (defun load-library (library) "Load the library named LIBRARY. This is an interface to the function `load'." (interactive "sLoad library: ") (load library)) (defun file-local-copy (file &optional buffer) "Copy the file FILE into a temporary file on this machine. Returns the name of the local copy, or nil, if FILE is directly accessible." (let ((handler (find-file-name-handler file 'file-local-copy))) (if handler (funcall handler 'file-local-copy file) nil))) (defun file-truename (filename &optional counter prev-dirs) "Return the truename of FILENAME, which should be absolute. The truename of a file name is found by chasing symbolic links both at the level of the file and at the level of the directories containing it, until no links are left at any level. The arguments COUNTER and PREV-DIRS are used only in recursive calls. Do not specify them in other calls." ;; COUNTER can be a cons cell whose car is the count of how many more links ;; to chase before getting an error. ;; PREV-DIRS can be a cons cell whose car is an alist ;; of truenames we've just recently computed. (if (or (string= filename "~") (and (string= (substring filename 0 1) "~") (string-match "~[^/]*" filename))) (progn (setq filename (expand-file-name filename)) (if (string= filename "") (setq filename "/")))) (or counter (setq counter (list 100))) (let (done ;; For speed, remove the ange-ftp completion handler from the list. ;; We know it's not needed here. ;; For even more speed, do this only on the outermost call. (file-name-handler-alist (if prev-dirs file-name-handler-alist (let ((tem (copy-sequence file-name-handler-alist))) (delq (rassq 'ange-ftp-completion-hook-function tem) tem))))) (or prev-dirs (setq prev-dirs (list nil))) ;; If this file directly leads to a link, process that iteratively ;; so that we don't use lots of stack. (while (not done) (setcar counter (1- (car counter))) (if (< (car counter) 0) (error "Apparent cycle of symbolic links for %s" filename)) (let ((handler (find-file-name-handler filename 'file-truename))) ;; For file name that has a special handler, call handler. ;; This is so that ange-ftp can save time by doing a no-op. (if handler (setq filename (funcall handler 'file-truename filename) done t) (let ((dir (file-name-directory filename)) target dirfile) ;; Get the truename of the directory. (setq dirfile (directory-file-name dir)) ;; If these are equal, we have the (or a) root directory. (or (string= dir dirfile) ;; If this is the same dir we last got the truename for, ;; save time--don't recalculate. (if (assoc dir (car prev-dirs)) (setq dir (cdr (assoc dir (car prev-dirs)))) (let ((old dir) (new (file-name-as-directory (file-truename dirfile counter prev-dirs)))) (setcar prev-dirs (cons (cons old new) (car prev-dirs))) (setq dir new)))) (if (equal ".." (file-name-nondirectory filename)) (setq filename (directory-file-name (file-name-directory (directory-file-name dir))) done t) (if (equal "." (file-name-nondirectory filename)) (setq filename (directory-file-name dir) done t) ;; Put it back on the file name. (setq filename (concat dir (file-name-nondirectory filename))) ;; Is the file name the name of a link? (setq target (file-symlink-p filename)) (if target ;; Yes => chase that link, then start all over ;; since the link may point to a directory name that uses links. ;; We can't safely use expand-file-name here ;; since target might look like foo/../bar where foo ;; is itself a link. Instead, we handle . and .. above. (setq filename (if (file-name-absolute-p target) target (concat dir target)) done nil) ;; No, we are done! (setq done t)))))))) filename)) (defun file-chase-links (filename) "Chase links in FILENAME until a name that is not a link. Does not examine containing directories for links, unlike `file-truename'." (let (tem (count 100) (newname filename)) (while (setq tem (file-symlink-p newname)) (if (= count 0) (error "Apparent cycle of symbolic links for %s" filename)) ;; In the context of a link, `//' doesn't mean what Emacs thinks. (while (string-match "//+" tem) (setq tem (concat (substring tem 0 (1+ (match-beginning 0))) (substring tem (match-end 0))))) ;; Handle `..' by hand, since it needs to work in the ;; target of any directory symlink. ;; This code is not quite complete; it does not handle ;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose. (while (string-match "\\`\\.\\./" tem) (setq tem (substring tem 3)) (setq newname (file-name-as-directory ;; Do the .. by hand. (directory-file-name (file-name-directory ;; Chase links in the default dir of the symlink. (file-chase-links (directory-file-name (file-name-directory newname)))))))) (setq newname (expand-file-name tem (file-name-directory newname))) (setq count (1- count))) newname)) (defun switch-to-buffer-other-window (buffer) "Select buffer BUFFER in another window." (interactive "BSwitch to buffer in other window: ") (let ((pop-up-windows t)) (pop-to-buffer buffer t))) (defun switch-to-buffer-other-frame (buffer) "Switch to buffer BUFFER in another frame." (interactive "BSwitch to buffer in other frame: ") (let ((pop-up-frames t)) (pop-to-buffer buffer t) (raise-frame (window-frame (selected-window))))) (defun find-file (filename) "Edit file FILENAME. Switch to a buffer visiting file FILENAME, creating one if none already exists." (interactive "FFind file: ") (switch-to-buffer (find-file-noselect filename))) (defun find-file-other-window (filename) "Edit file FILENAME, in another window. May create a new window, or reuse an existing one. See the function `display-buffer'." (interactive "FFind file in other window: ") (switch-to-buffer-other-window (find-file-noselect filename))) (defun find-file-other-frame (filename) "Edit file FILENAME, in another frame. May create a new frame, or reuse an existing one. See the function `display-buffer'." (interactive "FFind file in other frame: ") (switch-to-buffer-other-frame (find-file-noselect filename))) (defun find-file-read-only (filename) "Edit file FILENAME but don't allow changes. Like \\[find-file] but marks buffer as read-only. Use \\[toggle-read-only] to permit editing." (interactive "fFind file read-only: ") (find-file filename) (setq buffer-read-only t) (current-buffer)) (defun find-file-read-only-other-window (filename) "Edit file FILENAME in another window but don't allow changes. Like \\[find-file-other-window] but marks buffer as read-only. Use \\[toggle-read-only] to permit editing." (interactive "fFind file read-only other window: ") (find-file-other-window filename) (setq buffer-read-only t) (current-buffer)) (defun find-file-read-only-other-frame (filename) "Edit file FILENAME in another frame but don't allow changes. Like \\[find-file-other-frame] but marks buffer as read-only. Use \\[toggle-read-only] to permit editing." (interactive "fFind file read-only other frame: ") (find-file-other-frame filename) (setq buffer-read-only t) (current-buffer)) (defun find-alternate-file (filename) "Find file FILENAME, select its buffer, kill previous buffer. If the current buffer now contains an empty file that you just visited \(presumably by mistake), use this command to visit the file you really want." (interactive (let ((file buffer-file-name) (file-name nil) (file-dir nil)) (and file (setq file-name (file-name-nondirectory file) file-dir (file-name-directory file))) (list (read-file-name "Find alternate file: " file-dir nil nil file-name)))) (and (buffer-modified-p) ;; (not buffer-read-only) (not (yes-or-no-p (format "Buffer %s is modified; kill anyway? " (buffer-name)))) (error "Aborted")) (let ((obuf (current-buffer)) (ofile buffer-file-name) (onum buffer-file-number) (otrue buffer-file-truename) (oname (buffer-name))) (rename-buffer " **lose**") (setq buffer-file-name nil) (setq buffer-file-number nil) (setq buffer-file-truename nil) (unwind-protect (progn (unlock-buffer) (find-file filename)) (cond ((eq obuf (current-buffer)) (setq buffer-file-name ofile) (setq buffer-file-number onum) (setq buffer-file-truename otrue) (lock-buffer) (rename-buffer oname)))) (or (eq (current-buffer) obuf) (kill-buffer obuf)))) (defun create-file-buffer (filename) "Create a suitably named buffer for visiting FILENAME, and return it. FILENAME (sans directory) is used unchanged if that name is free; otherwise a string <2> or <3> or ... is appended to get an unused name." (let ((lastname (file-name-nondirectory filename))) (if (string= lastname "") (setq lastname filename)) (generate-new-buffer lastname))) (defun generate-new-buffer (name) "Create and return a buffer with a name based on NAME. Choose the buffer's name using `generate-new-buffer-name'." (get-buffer-create (generate-new-buffer-name name))) (defconst automount-dir-prefix "^/tmp_mnt/" "Regexp to match the automounter prefix in a directory name.") (defvar abbreviated-home-dir nil "The user's homedir abbreviated according to `directory-abbrev-list'.") (defun abbreviate-file-name (filename) "Return a version of FILENAME shortened using `directory-abbrev-alist'. This also substitutes \"~\" for the user's home directory. Type \\[describe-variable] directory-abbrev-alist RET for more information." ;; Get rid of the prefixes added by the automounter. (if (and (string-match automount-dir-prefix filename) (file-exists-p (file-name-directory (substring filename (1- (match-end 0)))))) (setq filename (substring filename (1- (match-end 0))))) (let ((tail directory-abbrev-alist)) ;; If any elt of directory-abbrev-alist matches this name, ;; abbreviate accordingly. (while tail (if (string-match (car (car tail)) filename) (setq filename (concat (cdr (car tail)) (substring filename (match-end 0))))) (setq tail (cdr tail))) ;; Compute and save the abbreviated homedir name. ;; We defer computing this until the first time it's needed, to ;; give time for directory-abbrev-alist to be set properly. ;; We include a slash at the end, to avoid spurious matches ;; such as `/usr/foobar' when the home dir is `/usr/foo'. (or abbreviated-home-dir (setq abbreviated-home-dir (let ((abbreviated-home-dir "$foo")) (concat "^" (abbreviate-file-name (expand-file-name "~")) "\\(/\\|$\\)")))) ;; If FILENAME starts with the abbreviated homedir, ;; make it start with `~' instead. (if (and (string-match abbreviated-home-dir filename) ;; If the home dir is just /, don't change it. (not (and (= (match-end 0) 1) (= (aref filename 0) ?/))) (not (and (eq system-type 'ms-dos) (save-match-data (string-match "^[a-zA-Z]:/$" filename))))) (setq filename (concat "~" (substring filename (match-beginning 1) (match-end 1)) (substring filename (match-end 0))))) filename)) (defvar find-file-not-true-dirname-list nil "*List of logical names for which visiting shouldn't save the true dirname. On VMS, when you visit a file using a logical name that searches a path, you may or may not want the visited file name to record the specific directory where the file was found. If you *do not* want that, add the logical name to this list as a string.") (defun find-buffer-visiting (filename) "Return the buffer visiting file FILENAME (a string). This is like `get-file-buffer', except that it checks for any buffer visiting the same file, possibly under a different name. If there is no such live buffer, return nil." (let ((buf (get-file-buffer filename)) (truename (abbreviate-file-name (file-truename filename)))) (or buf (let ((list (buffer-list)) found) (while (and (not found) list) (save-excursion (set-buffer (car list)) (if (and buffer-file-name (string= buffer-file-truename truename)) (setq found (car list)))) (setq list (cdr list))) found) (let ((number (nthcdr 10 (file-attributes truename))) (list (buffer-list)) found) (and number (while (and (not found) list) (save-excursion (set-buffer (car list)) (if (and buffer-file-name (equal buffer-file-number number) ;; Verify this buffer's file number ;; still belongs to its file. (file-exists-p buffer-file-name) (equal (nthcdr 10 (file-attributes buffer-file-name)) number)) (setq found (car list)))) (setq list (cdr list)))) found)))) (defvar find-file-expand-completelly-list nil "*List of logicals names which should be completelly expanded. On VMS, vms-expand-search-paths will normally expand paths until it is unique, that is until the device name only designates one place. There might be cases, though, when you want the logical names to be expanded completelly, and only get a real device name as device. In that case, add that logical name to this list.") ;;; The following function is needed, mostly to make it more elegant (defun file-truename-wrap (filename) (if (eq system-type 'vax-vms) (file-truename filename (and (string-match ":" (file-name-directory filename)) (member (substring (file-name-directory filename) 0 (match-beginning 0)) find-file-expand-completelly-list))) (file-truename filename))) (defun find-file-noselect (filename &optional nowarn) "Read file FILENAME into a buffer and return the buffer. If a buffer exists visiting FILENAME, return that one, but verify that the file has not changed since visited or saved. The buffer is not selected, just returned to the caller." (setq filename (abbreviate-file-name (expand-file-name filename))) (if (file-directory-p filename) (if find-file-run-dired (dired-noselect filename) (error "%s is a directory." filename)) (let* ((buf (get-file-buffer filename)) (truename (abbreviate-file-name (file-truename-wrap filename))) (number (nthcdr 10 (file-attributes truename))) ;; Find any buffer for a file which has same truename. (other (and (not buf) (find-buffer-visiting filename))) error) ;; Let user know if there is a buffer with the same truename. (if other (progn (or nowarn (string-equal filename (buffer-file-name other)) (message "%s and %s are the same file" filename (buffer-file-name other))) ;; Optionally also find that buffer. (if (or find-file-existing-other-name find-file-visit-truename) (setq buf other)))) (if buf (or nowarn (verify-visited-file-modtime buf) (cond ((not (file-exists-p filename)) (error "File %s no longer exists!" filename)) ((yes-or-no-p (format (if (buffer-modified-p buf) "File %s changed on disk. Discard your edits? " "File %s changed on disk. Reread from disk? ") (file-name-nondirectory filename))) (save-excursion (set-buffer buf) (revert-buffer t t))))) (save-excursion ;;; The truename stuff makes this obsolete. ;;; (let* ((link-name (car (file-attributes filename))) ;;; (linked-buf (and (stringp link-name) ;;; (get-file-buffer link-name)))) ;;; (if (bufferp linked-buf) ;;; (message "Symbolic link to file in buffer %s" ;;; (buffer-name linked-buf)))) (setq buf (create-file-buffer filename)) (set-buffer buf) (erase-buffer) (condition-case () (insert-file-contents filename t) (file-error (setq error t) ;; Run find-file-not-found-hooks until one returns non-nil. (let ((hooks find-file-not-found-hooks)) (while (and hooks (not (and (funcall (car hooks)) ;; If a hook succeeded, clear error. (progn (setq error nil) ;; Also exit the loop. t)))) (setq hooks (cdr hooks)))))) ;; Find the file's truename, and maybe use that as visited name. (setq buffer-file-truename truename) (setq buffer-file-number number) ;; On VMS, we may want to remember which directory in a search list ;; the file was found in. (and (eq system-type 'vax-vms) (let (logical) (if (string-match ":" (file-name-directory filename)) (setq logical (substring (file-name-directory filename) 0 (match-beginning 0)))) (not (member logical find-file-not-true-dirname-list))) (setq buffer-file-name buffer-file-truename)) (if find-file-visit-truename (setq buffer-file-name (setq filename (expand-file-name buffer-file-truename)))) ;; Set buffer's default directory to that of the file. (setq default-directory (file-name-directory filename)) ;; Turn off backup files for certain file names. Since ;; this is a permanent local, the major mode won't eliminate it. (and (not (funcall backup-enable-predicate buffer-file-name)) (progn (make-local-variable 'backup-inhibited) (setq backup-inhibited t))) (after-find-file error (not nowarn)))) buf))) (defvar after-find-file-from-revert-buffer nil) (defun after-find-file (&optional error warn noauto after-find-file-from-revert-buffer) "Called after finding a file and by the default revert function. Sets buffer mode, parses local variables. Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an error in reading the file. WARN non-nil means warn if there exists an auto-save file more recent than the visited file. NOAUTO means don't mess with auto-save mode. Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER non-nil means this call was from `revert-buffer'. Finishes by calling the functions in `find-file-hooks'." (setq buffer-read-only (not (file-writable-p buffer-file-name))) (if noninteractive nil (let* (not-serious (msg (cond ((and error (file-attributes buffer-file-name)) (setq buffer-read-only t) "File exists, but cannot be read.") ((not buffer-read-only) (if (and warn (file-newer-than-file-p (make-auto-save-file-name) buffer-file-name)) "Auto save file is newer; consider M-x recover-file" (setq not-serious t) (if error "(New file)" nil))) ((not error) (setq not-serious t) "Note: file is write protected") ((file-attributes (directory-file-name default-directory)) "File not found and directory write-protected") ((file-exists-p (file-name-directory buffer-file-name)) (setq buffer-read-only nil)) (t (setq buffer-read-only nil) (if (file-exists-p (file-name-directory (directory-file-name (file-name-directory buffer-file-name)))) "Use M-x make-dir RET RET to create the directory" "Use C-u M-x make-dir RET RET to create directory and its parents"))))) (if msg (progn (message msg) (or not-serious (sit-for 1 nil t))))) (if (and auto-save-default (not noauto)) (auto-save-mode t))) (normal-mode t) (mapcar 'funcall find-file-hooks)) (defun normal-mode (&optional find-file) "Choose the major mode for this buffer automatically. Also sets up any specified local variables of the file. Uses the visited file name, the -*- line, and the local variables spec. This function is called automatically from `find-file'. In that case, we may set up specified local variables depending on the value of `enable-local-variables': if it is t, we do; if it is nil, we don't; otherwise, we query. `enable-local-variables' is ignored if you run `normal-mode' explicitly." (interactive) (or find-file (funcall (or default-major-mode 'fundamental-mode))) (condition-case err (set-auto-mode) (error (message "File mode specification error: %s" (prin1-to-string err)))) (condition-case err (let ((enable-local-variables (or (not find-file) enable-local-variables))) (hack-local-variables)) (error (message "File local-variables error: %s" (prin1-to-string err))))) (defvar auto-mode-alist (mapcar 'purecopy '(("\\.text\\'" . text-mode) ("\\.c\\'" . c-mode) ("\\.h\\'" . c-mode) ("\\.tex\\'" . TeX-mode) ("\\.ltx\\'" . LaTeX-mode) ("\\.el\\'" . emacs-lisp-mode) ("\\.mm\\'" . nroff-mode) ("\\.me\\'" . nroff-mode) ("\\.ms\\'" . nroff-mode) ("\\.man\\'" . nroff-mode) ("\\.scm\\'" . scheme-mode) ("\\.l\\'" . lisp-mode) ("\\.lisp\\'" . lisp-mode) ("\\.f\\'" . fortran-mode) ("\\.for\\'" . fortran-mode) ("\\.p\\'" . pascal-mode) ("\\.pas\\'" . pascal-mode) ("\\.mss\\'" . scribe-mode) ("\\.pl\\'" . prolog-mode) ("\\.cc\\'" . c++-mode) ("\\.hh\\'" . c++-mode) ("\\.C\\'" . c++-mode) ("\\.H\\'" . c++-mode) ;;; ("\\.mk\\'" . makefile-mode) ;;; ("[Mm]akefile" . makefile-mode) ;;; Less common extensions come here ;;; so more common ones above are found faster. ("\\.texinfo\\'" . texinfo-mode) ("\\.texi\\'" . texinfo-mode) ("\\.s\\'" . asm-mode) ("ChangeLog\\'" . change-log-mode) ("change.log\\'" . change-log-mode) ("changelo\\'" . change-log-mode) ("ChangeLog.[0-9]+\\'" . change-log-mode) ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode) ;; The following should come after the ChangeLog pattern ;; for the sake of ChangeLog.1, etc. ("\\.[12345678]\\'" . nroff-mode) ("\\.TeX\\'" . TeX-mode) ("\\.sty\\'" . LaTeX-mode) ("\\.bbl\\'" . LaTeX-mode) ("\\.bib\\'" . bibtex-mode) ("\\.article\\'" . text-mode) ("\\.letter\\'" . text-mode) ("\\.tcl\\'" . tcl-mode) ("\\.lsp\\'" . lisp-mode) ("\\.awk\\'" . awk-mode) ("\\.prolog\\'" . prolog-mode) ("\\.tar\\'" . tar-mode) ;; Mailer puts message to be edited in ;; /tmp/Re.... or Message ("^/tmp/Re" . text-mode) ("/Message[0-9]*\\'" . text-mode) ;; some news reader is reported to use this ("^/tmp/fol/" . text-mode) ("\\.y\\'" . c-mode) ("\\.lex\\'" . c-mode) ("\\.oak\\'" . scheme-mode) ("\\.scm.[0-9]*\\'" . scheme-mode) ("\\.sgm\\'" . sgml-mode) ("\\.sgml\\'" . sgml-mode) ("\\.dtd\\'" . sgml-mode) ;; .emacs following a directory delimiter ;; in either Unix or VMS syntax. ("[]>:/]\\..*emacs\\'" . emacs-lisp-mode) ;; _emacs following a directory delimiter ;; in MsDos syntax ("[:/]_emacs\\'" . emacs-lisp-mode) ("\\.ml\\'" . lisp-mode))) "\ Alist of filename patterns vs corresponding major mode functions. Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION). Visiting a file whose name matches REGEXP causes FUNCTION to be called. If the element has the form (REGEXP FUNCTION), then after calling FUNCTION, we delete the suffix that matched REGEXP and search the list again for another match.") (defconst interpreter-mode-alist '(("perl" . perl-mode) ("wish" . tcl-mode) ("wishx" . tcl-mode) ("tcl" . tcl-mode) ("tclsh" . tcl-mode) ("awk" . awk-mode) ("gawk" . awk-mode) ("scm" . scheme-mode)) "Alist mapping interpreter names to major modes. This alist applies to files whose first line starts with `#!'. Each element looks like (INTERPRETER . MODE). The car of each element is compared with the name of the interpreter specified in the first line. If it matches, mode MODE is selected.") (defconst inhibit-first-line-modes-regexps '("\\.tar$") "List of regexps; if one matches a file name, don't look for `-*-'.") (defvar user-init-file "" ; set by command-line "File name including directory of user's initialization file.") (defun set-auto-mode () "Select major mode appropriate for current buffer. This checks for a -*- mode tag in the buffer's text, compares the filename against the entries in `auto-mode-alist', or checks the interpreter that runs this file against `interpreter-mode-alist'. It does not check for the `mode:' local variable in the Local Variables section of the file; for that, use `hack-local-variables'. If `enable-local-variables' is nil, this function does not check for a -*- mode tag." ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*- (let (beg end done) (save-excursion (goto-char (point-min)) (skip-chars-forward " \t\n") (and enable-local-variables ;; Don't look for -*- if this file name matches any ;; of the regexps in inhibit-first-line-modes-regexps. (let ((temp inhibit-first-line-modes-regexps)) (while (and temp (not (string-match (car temp) buffer-file-name))) (setq temp (cdr temp))) (not temp)) (search-forward "-*-" (save-excursion ;; If the file begins with "#!" ;; (exec interpreter magic), look ;; for mode frobs in the first two ;; lines. You cannot necessarily ;; put them in the first line of ;; such a file without screwing up ;; the interpreter invocation. (end-of-line (and (looking-at "^#!") 2)) (point)) t) (progn (skip-chars-forward " \t") (setq beg (point)) (search-forward "-*-" (save-excursion (end-of-line) (point)) t)) (progn (forward-char -3) (skip-chars-backward " \t") (setq end (point)) (goto-char beg) (if (save-excursion (search-forward ":" end t)) ;; Find all specifications for the `mode:' variable ;; and execute them left to right. (while (let ((case-fold-search t)) (search-forward "mode:" end t)) (skip-chars-forward " \t") (setq beg (point)) (if (search-forward ";" end t) (forward-char -1) (goto-char end)) (skip-chars-backward " \t") (funcall (intern (concat (downcase (buffer-substring beg (point))) "-mode")))) ;; Simple -*-MODE-*- case. (funcall (intern (concat (downcase (buffer-substring beg end)) "-mode")))) (setq done t))) ;; If we didn't find a mode from a -*- line, try using the file name. (if (and (not done) buffer-file-name) (let ((name buffer-file-name) (keep-going t)) ;; Remove backup-suffixes from file name. (setq name (file-name-sans-versions name)) (while keep-going (setq keep-going nil) (let ((alist auto-mode-alist) (mode nil)) ;; Find first matching alist entry. (let ((case-fold-search (eq system-type 'vax-vms))) (while (and (not mode) alist) (if (string-match (car (car alist)) name) (if (and (consp (cdr (car alist))) (nth 2 (car alist))) (progn (setq mode (car (cdr (car alist))) name (substring name 0 (match-beginning 0)) keep-going t)) (setq mode (cdr (car alist)) keep-going nil))) (setq alist (cdr alist)))) (if mode (funcall mode) ;; If we can't deduce a mode from the file name, ;; look for an interpreter specified in the first line. (let ((interpreter (save-excursion (goto-char (point-min)) (if (looking-at "#! *\\([^ \t\n]+\\)") (buffer-substring (match-beginning 1) (match-end 1)) ""))) elt) ;; Map interpreter name to a mode. (setq elt (assoc (file-name-nondirectory interpreter) interpreter-mode-alist)) (if elt (funcall (cdr elt)))))))))))) (defun hack-local-variables-prop-line () ;; Set local variables specified in the -*- line. ;; Ignore any specification for `mode:'; ;; set-auto-mode should already have handled that. (save-excursion (goto-char (point-min)) (let ((result nil) (end (save-excursion (end-of-line (and (looking-at "^#!") 2)) (point)))) ;; Parse the -*- line into the `result' alist. (cond ((not (search-forward "-*-" end t)) ;; doesn't have one. nil) ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)") ;; Simple form: "-*- MODENAME -*-". Already handled. nil) (t ;; Hairy form: '-*-' [ ':' ';' ]* '-*-' ;; (last ";" is optional). (save-excursion (if (search-forward "-*-" end t) (setq end (- (point) 3)) (error "-*- not terminated before end of line"))) (while (< (point) end) (or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*") (error "malformed -*- line")) (goto-char (match-end 0)) (let ((key (intern (downcase (buffer-substring (match-beginning 1) (match-end 1))))) (val (save-restriction (narrow-to-region (point) end) (read (current-buffer))))) (or (eq key 'mode) (setq result (cons (cons key val) result))) (skip-chars-forward " \t;"))) (setq result (nreverse result)))) (if (and result (or (eq enable-local-variables t) (and enable-local-variables (save-window-excursion (condition-case nil (switch-to-buffer (current-buffer)) (error ;; If we fail to switch in the selected window, ;; it is probably a minibuffer. ;; So try another window. (condition-case nil (switch-to-buffer-other-window (current-buffer)) (error (switch-to-buffer-other-frame (current-buffer)))))) (y-or-n-p (format "Set local variables as specified in -*- line of %s? " (file-name-nondirectory buffer-file-name))))))) (while result (hack-one-local-variable (car (car result)) (cdr (car result))) (setq result (cdr result))))))) (defun hack-local-variables () "Parse and put into effect this buffer's local variables spec." (hack-local-variables-prop-line) ;; Look for "Local variables:" line in last page. (save-excursion (goto-char (point-max)) (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move) (if (let ((case-fold-search t)) (and (search-forward "Local Variables:" nil t) (or (eq enable-local-variables t) (and enable-local-variables (save-window-excursion (switch-to-buffer (current-buffer)) (save-excursion (beginning-of-line) (set-window-start (selected-window) (point))) (y-or-n-p (format "Set local variables as specified at end of %s? " (if buffer-file-name (file-name-nondirectory buffer-file-name) (concat "buffer " (buffer-name)))))))))) (let ((continue t) prefix prefixlen suffix beg (enable-local-eval enable-local-eval)) ;; The prefix is what comes before "local variables:" in its line. ;; The suffix is what comes after "local variables:" in its line. (skip-chars-forward " \t") (or (eolp) (setq suffix (buffer-substring (point) (progn (end-of-line) (point))))) (goto-char (match-beginning 0)) (or (bolp) (setq prefix (buffer-substring (point) (progn (beginning-of-line) (point))))) (if prefix (setq prefixlen (length prefix) prefix (regexp-quote prefix))) (if suffix (setq suffix (concat (regexp-quote suffix) "$"))) (while continue ;; Look at next local variable spec. (if selective-display (re-search-forward "[\n\C-m]") (forward-line 1)) ;; Skip the prefix, if any. (if prefix (if (looking-at prefix) (forward-char prefixlen) (error "Local variables entry is missing the prefix"))) ;; Find the variable name; strip whitespace. (skip-chars-forward " \t") (setq beg (point)) (skip-chars-forward "^:\n") (if (eolp) (error "Missing colon in local variables entry")) (skip-chars-backward " \t") (let* ((str (buffer-substring beg (point))) (var (read str)) val) ;; Setting variable named "end" means end of list. (if (string-equal (downcase str) "end") (setq continue nil) ;; Otherwise read the variable value. (skip-chars-forward "^:") (forward-char 1) (setq val (read (current-buffer))) (skip-chars-backward "\n") (skip-chars-forward " \t") (or (if suffix (looking-at suffix) (eolp)) (error "Local variables entry is terminated incorrectly")) ;; Set the variable. "Variables" mode and eval are funny. (hack-one-local-variable var val)))))))) (defconst ignored-local-variables '(enable-local-eval) "Variables to be ignored in a file's local variable spec.") ;; Get confirmation before setting these variables as locals in a file. (put 'debugger 'risky-local-variable t) (put 'enable-local-eval 'risky-local-variable t) (put 'eval 'risky-local-variable t) (put 'file-name-handler-alist 'risky-local-variable t) (put 'minor-mode-map-alist 'risky-local-variable t) (put 'after-load-alist 'risky-local-variable t) (put 'buffer-file-name 'risky-local-variable t) (put 'buffer-auto-save-file-name 'risky-local-variable t) (put 'buffer-file-truename 'risky-local-variable t) (put 'exec-path 'risky-local-variable t) (put 'load-path 'risky-local-variable t) (put 'exec-directory 'risky-local-variable t) (put 'process-environment 'risky-local-variable t) ;; Don't wait for outline.el to be loaded, for the sake of outline-minor-mode. (put 'outline-level 'risky-local-variable t) (put 'rmail-output-file-alist 'risky-local-variable t) (defun hack-one-local-variable-quotep (exp) (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp)))) ;; "Set" one variable in a local variables spec. ;; A few variable names are treated specially. (defun hack-one-local-variable (var val) (cond ((eq var 'mode) (funcall (intern (concat (downcase (symbol-name val)) "-mode")))) ((memq var ignored-local-variables) nil) ;; "Setting" eval means either eval it or do nothing. ;; Likewise for setting hook variables. ((or (get var 'risky-local-variable) (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$" (symbol-name var))) ;; Permit evaling a put of a harmless property ;; if the args do nothing tricky. (if (or (and (eq var 'eval) (consp val) (eq (car val) 'put) (hack-one-local-variable-quotep (nth 1 val)) (hack-one-local-variable-quotep (nth 2 val)) ;; Only allow safe values of lisp-indent-hook; ;; not functions. (or (numberp (nth 3 val)) (equal (nth 3 val) ''defun)) (memq (nth 1 (nth 2 val)) '(lisp-indent-hook))) ;; Permit eval if not root and user says ok. (and (not (zerop (user-uid))) (or (eq enable-local-eval t) (and enable-local-eval (save-window-excursion (switch-to-buffer (current-buffer)) (save-excursion (beginning-of-line) (set-window-start (selected-window) (point))) (setq enable-local-eval (y-or-n-p (format "Process `eval' or hook local variables in file %s? " (file-name-nondirectory buffer-file-name))))))))) (if (eq var 'eval) (save-excursion (eval val)) (make-local-variable var) (set var val)) (message "Ignoring `eval:' in file's local variables"))) ;; Ordinary variable, really set it. (t (make-local-variable var) (set var val)))) (defun set-visited-file-name (filename) "Change name of file visited in current buffer to FILENAME. The next time the buffer is saved it will go in the newly specified file. nil or empty string as argument means make buffer not be visiting any file. Remember to delete the initial contents of the minibuffer if you wish to pass an empty string as the argument." (interactive "FSet visited file name: ") (let (truename) (if filename (setq filename (if (string-equal filename "") nil (expand-file-name filename)))) (if filename (progn (setq truename (file-truename-wrap filename)) (if find-file-visit-truename ;; Do not use the abbreviated filename, because ;; write-region will reset it to the expanded filename (setq filename truename)))) (or (equal filename buffer-file-name) (progn (and filename (lock-buffer filename)) (unlock-buffer))) (setq buffer-file-name filename) (if filename ; make buffer name reflect filename. (let ((new-name (file-name-nondirectory buffer-file-name))) (if (string= new-name "") (error "Empty file name")) (if (eq system-type 'vax-vms) (setq new-name (downcase new-name))) (setq default-directory (file-name-directory buffer-file-name)) (or (string= new-name (buffer-name)) (rename-buffer new-name t)))) (setq buffer-backed-up nil) (clear-visited-file-modtime) (if truename (setq buffer-file-truename (abbreviate-file-name truename))) (setq buffer-file-number (if filename (nth 10 (file-attributes buffer-file-name)) nil))) ;; write-file-hooks is normally used for things like ftp-find-file ;; that visit things that are not local files as if they were files. ;; Changing to visit an ordinary local file instead should flush the hook. (kill-local-variable 'write-file-hooks) (kill-local-variable 'local-write-file-hooks) (kill-local-variable 'revert-buffer-function) (kill-local-variable 'backup-inhibited) ;; If buffer was read-only because of version control, ;; that reason is gone now, so make it writable. (if vc-mode (setq buffer-read-only nil)) (kill-local-variable 'vc-mode) ;; Turn off backup files for certain file names. ;; Since this is a permanent local, the major mode won't eliminate it. (and (not (funcall backup-enable-predicate buffer-file-name)) (progn (make-local-variable 'backup-inhibited) (setq backup-inhibited t))) (let ((oauto buffer-auto-save-file-name)) ;; If auto-save was not already on, turn it on if appropriate. (if (not buffer-auto-save-file-name) (and buffer-file-name auto-save-default (auto-save-mode t)) ;; If auto save is on, start using a new name. ;; We deliberately don't rename or delete the old auto save ;; for the old visited file name. This is because perhaps ;; the user wants to save the new state and then compare with the ;; previous state from the auto save file. (setq buffer-auto-save-file-name (make-auto-save-file-name))) ;; Rename the old auto save file if any. (and oauto buffer-auto-save-file-name (file-exists-p oauto) (rename-file oauto buffer-auto-save-file-name t))) (if buffer-file-name (set-buffer-modified-p t))) (defun write-file (filename) "Write current buffer into file FILENAME. Makes buffer visit that file, and marks it not modified. If the buffer is already visiting a file, you can specify a directory name as FILENAME, to write a file of the same old name in that directory." ;; (interactive "FWrite file: ") (interactive (list (if buffer-file-name (read-file-name "Write file: " nil nil nil nil) (read-file-name "Write file: " (cdr (assq 'default-directory (buffer-local-variables))) nil nil (buffer-name))))) (or (null filename) (string-equal filename "") (progn ;; If arg is just a directory, ;; use same file name, but in that directory. (if (and (file-directory-p filename) buffer-file-name) (setq filename (concat (file-name-as-directory filename) (file-name-nondirectory buffer-file-name)))) (set-visited-file-name filename))) (set-buffer-modified-p t) (save-buffer)) (defun backup-buffer () "Make a backup of the disk file visited by the current buffer, if appropriate. This is normally done before saving the buffer the first time. If the value is non-nil, it is the result of `file-modes' on the original file; this means that the caller, after saving the buffer, should change the modes of the new file to agree with the old modes." (if (and make-backup-files (not backup-inhibited) (not buffer-backed-up) (file-exists-p buffer-file-name) (memq (aref (elt (file-attributes buffer-file-name) 8) 0) '(?- ?l))) (let ((real-file-name buffer-file-name) backup-info backupname targets setmodes) ;; If specified name is a symbolic link, chase it to the target. ;; Thus we make the backups in the directory where the real file is. (setq real-file-name (file-chase-links real-file-name)) (setq backup-info (find-backup-file-name real-file-name) backupname (car backup-info) targets (cdr backup-info)) ;;; (if (file-directory-p buffer-file-name) ;;; (error "Cannot save buffer in directory %s" buffer-file-name)) (condition-case () (let ((delete-old-versions ;; If have old versions to maybe delete, ;; ask the user to confirm now, before doing anything. ;; But don't actually delete til later. (and targets (or (eq delete-old-versions t) (eq delete-old-versions nil)) (or delete-old-versions (y-or-n-p (format "Delete excess backup versions of %s? " real-file-name)))))) ;; Actually write the back up file. (condition-case () (if (or file-precious-flag ; (file-symlink-p buffer-file-name) backup-by-copying (and backup-by-copying-when-linked (> (file-nlinks real-file-name) 1)) (and backup-by-copying-when-mismatch (let ((attr (file-attributes real-file-name))) (or (nth 9 attr) (/= (nth 2 attr) (user-uid)))))) (condition-case () (copy-file real-file-name backupname t t) (file-error ;; If copying fails because file BACKUPNAME ;; is not writable, delete that file and try again. (if (and (file-exists-p backupname) (not (file-writable-p backupname))) (delete-file backupname)) (copy-file real-file-name backupname t t))) ;; rename-file should delete old backup. (rename-file real-file-name backupname t) (setq setmodes (file-modes backupname))) (file-error ;; If trouble writing the backup, write it in ~. (setq backupname (expand-file-name "~/%backup%~")) (message "Cannot write backup file; backing up in ~/%%backup%%~") (sleep-for 1) (condition-case () (copy-file real-file-name backupname t t) (file-error ;; If copying fails because file BACKUPNAME ;; is not writable, delete that file and try again. (if (and (file-exists-p backupname) (not (file-writable-p backupname))) (delete-file backupname)) (copy-file real-file-name backupname t t))))) (setq buffer-backed-up t) ;; Now delete the old versions, if desired. (if delete-old-versions (while targets (condition-case () (delete-file (car targets)) (file-error nil)) (setq targets (cdr targets)))) setmodes) (file-error nil))))) (defun file-name-sans-versions (name &optional keep-backup-version) "Return FILENAME sans backup versions or strings. This is a separate procedure so your site-init or startup file can redefine it. If the optional argument KEEP-BACKUP-VERSION is non-nil, we do not remove backup version numbers, only true file version numbers." (let ((handler (find-file-name-handler name 'file-name-sans-versions))) (if handler (funcall handler 'file-name-sans-versions name keep-backup-version) (substring name 0 (if (eq system-type 'vax-vms) ;; VMS version number is (a) semicolon, optional ;; sign, zero or more digits or (b) period, option ;; sign, zero or more digits, provided this is the ;; second period encountered outside of the ;; device/directory part of the file name. (or (string-match ";[-+]?[0-9]*\\'" name) (if (string-match "\\.[^]>:]*\\(\\.[-+]?[0-9]*\\)\\'" name) (match-beginning 1)) (length name)) (if keep-backup-version (length name) (or (string-match "\\.~[0-9]+~\\'" name) (string-match "~\\'" name) (length name)))))))) (defun make-backup-file-name (file) "Create the non-numeric backup file name for FILE. This is a separate function so you can redefine it for customization." (if (eq system-type 'ms-dos) (let ((fn (file-name-nondirectory file))) (concat (file-name-directory file) (if (string-match "\\([^.]*\\)\\(\\..*\\)?" fn) (substring fn 0 (match-end 1))) ".bak")) (concat file "~"))) (defun backup-file-name-p (file) "Return non-nil if FILE is a backup file name (numeric or not). This is a separate function so you can redefine it for customization. You may need to redefine `file-name-sans-versions' as well." (if (eq system-type 'ms-dos) (string-match "\\.bak$" file) (string-match "~$" file))) ;; This is used in various files. ;; The usage of bv-length is not very clean, ;; but I can't see a good alternative, ;; so as of now I am leaving it alone. (defun backup-extract-version (fn) "Given the name of a numeric backup file, return the backup number. Uses the free variable `bv-length', whose value should be the index in the name where the version number begins." (if (and (string-match "[0-9]+~$" fn bv-length) (= (match-beginning 0) bv-length)) (string-to-int (substring fn bv-length -1)) 0)) ;; I believe there is no need to alter this behavior for VMS; ;; since backup files are not made on VMS, it should not get called. (defun find-backup-file-name (fn) "Find a file name for a backup file, and suggestions for deletions. Value is a list whose car is the name for the backup file and whose cdr is a list of old versions to consider deleting now." (if (eq version-control 'never) (list (make-backup-file-name fn)) (let* ((base-versions (concat (file-name-nondirectory fn) ".~")) (bv-length (length base-versions)) possibilities (versions nil) (high-water-mark 0) (deserve-versions-p nil) (number-to-delete 0)) (condition-case () (setq possibilities (file-name-all-completions base-versions (file-name-directory fn)) versions (sort (mapcar (function backup-extract-version) possibilities) '<) high-water-mark (apply 'max 0 versions) deserve-versions-p (or version-control (> high-water-mark 0)) number-to-delete (- (length versions) kept-old-versions kept-new-versions -1)) (file-error (setq possibilities nil))) (if (not deserve-versions-p) (list (make-backup-file-name fn)) (cons (concat fn ".~" (int-to-string (1+ high-water-mark)) "~") (if (and (> number-to-delete 0) ;; Delete nothing if there is overflow ;; in the number of versions to keep. (>= (+ kept-new-versions kept-old-versions -1) 0)) (mapcar (function (lambda (n) (concat fn ".~" (int-to-string n) "~"))) (let ((v (nthcdr kept-old-versions versions))) (rplacd (nthcdr (1- number-to-delete) v) ()) v)))))))) (defun file-nlinks (filename) "Return number of names file FILENAME has." (car (cdr (file-attributes filename)))) (defun file-relative-name (filename &optional directory) "Convert FILENAME to be relative to DIRECTORY (default: default-directory)." (setq filename (expand-file-name filename) directory (file-name-as-directory (expand-file-name (or directory default-directory)))) (let ((ancestor "")) (while (not (string-match (concat "^" (regexp-quote directory)) filename)) (setq directory (file-name-directory (substring directory 0 -1)) ancestor (concat "../" ancestor))) (concat ancestor (substring filename (match-end 0))))) (defun save-buffer (&optional args) "Save current buffer in visited file if modified. Versions described below. By default, makes the previous version into a backup file if previously requested or if this is the first save. With 1 or 3 \\[universal-argument]'s, marks this version to become a backup when the next save is done. With 2 or 3 \\[universal-argument]'s, unconditionally makes the previous version into a backup file. With argument of 0, never makes the previous version into a backup file. If a file's name is FOO, the names of its numbered backup versions are FOO.~i~ for various integers i. A non-numbered backup file is called FOO~. Numeric backups (rather than FOO~) will be made if value of `version-control' is not the atom `never' and either there are already numeric versions of the file being backed up, or `version-control' is non-nil. We don't want excessive versions piling up, so there are variables `kept-old-versions', which tells Emacs how many oldest versions to keep, and `kept-new-versions', which tells how many newest versions to keep. Defaults are 2 old versions and 2 new. `dired-kept-versions' controls dired's clean-directory (.) command. If `delete-old-versions' is nil, system will query user before trimming versions. Otherwise it does it silently." (interactive "p") (let ((modp (buffer-modified-p)) (large (> (buffer-size) 50000)) (make-backup-files (or (and make-backup-files (not (eq args 0))) (memq args '(16 64))))) (and modp (memq args '(16 64)) (setq buffer-backed-up nil)) (if (and modp large) (message "Saving file %s..." (buffer-file-name))) (basic-save-buffer) (and modp (memq args '(4 64)) (setq buffer-backed-up nil)))) (defun delete-auto-save-file-if-necessary (&optional force) "Delete auto-save file for current buffer if `delete-auto-save-files' is t. Normally delete only if the file was written by this Emacs since the last real save, but optional arg FORCE non-nil means delete anyway." (and buffer-auto-save-file-name delete-auto-save-files (not (string= buffer-file-name buffer-auto-save-file-name)) (or force (recent-auto-save-p)) (progn (condition-case () (delete-file buffer-auto-save-file-name) (file-error nil)) (set-buffer-auto-saved)))) (defun basic-save-buffer () "Save the current buffer in its visited file, if it has been modified." (interactive) (if (buffer-modified-p) (let ((recent-save (recent-auto-save-p)) setmodes tempsetmodes) ;; On VMS, rename file and buffer to get rid of version number. (if (and (eq system-type 'vax-vms) buffer-file-name (not (string= buffer-file-name (file-name-sans-versions buffer-file-name)))) (let (buffer-new-name) ;; Strip VMS version number before save. (setq buffer-file-name (file-name-sans-versions buffer-file-name)) ;; Construct a (unique) buffer name to correspond. (let ((buf (create-file-buffer (downcase buffer-file-name)))) (setq buffer-new-name (buffer-name buf)) (kill-buffer buf)) (rename-buffer buffer-new-name))) ;; If buffer has no file name, ask user for one. (or buffer-file-name (set-visited-file-name (expand-file-name (read-file-name "File to save in: ") nil))) (or (verify-visited-file-modtime (current-buffer)) (not (file-exists-p buffer-file-name)) (yes-or-no-p (format "%s has changed since visited or saved. Save anyway? " (file-name-nondirectory buffer-file-name))) (error "Save not confirmed")) (save-restriction (widen) (and (> (point-max) 1) (/= (char-after (1- (point-max))) ?\n) (not (and (eq selective-display t) (= (char-after (1- (point-max))) ?\r))) (or (eq require-final-newline t) (and require-final-newline (y-or-n-p (format "Buffer %s does not end in newline. Add one? " (buffer-name))))) (save-excursion (goto-char (point-max)) (insert ?\n))) (let ((hooks (append write-contents-hooks local-write-file-hooks write-file-hooks)) (done nil)) (while (and hooks (not (setq done (funcall (car hooks))))) (setq hooks (cdr hooks))) ;; If a hook returned t, file is already "written". (cond ((not done) (setq setmodes (basic-save-buffer-1))))) (setq buffer-file-number (nth 10 (file-attributes buffer-file-name))) (if setmodes (condition-case () (set-file-modes buffer-file-name setmodes) (error nil)))) ;; If the auto-save file was recent before this command, ;; delete it now. (delete-auto-save-file-if-necessary recent-save) (run-hooks 'after-save-hook)) (message "(No changes need to be saved)"))) ;; This does the "real job" of writing a buffer into its visited file ;; and making a backup file. This is what is normally done ;; but inhibited if one of write-file-hooks returns non-nil. ;; It returns a value to store in setmodes. (defun basic-save-buffer-1 () (let (tempsetmodes setmodes) (if (not (file-writable-p buffer-file-name)) (let ((dir (file-name-directory buffer-file-name))) (if (not (file-directory-p dir)) (error "%s is not a directory" dir) (if (not (file-exists-p buffer-file-name)) (error "Directory %s write-protected" dir) (if (yes-or-no-p (format "File %s is write-protected; try to save anyway? " (file-name-nondirectory buffer-file-name))) (setq tempsetmodes t) (error "Attempt to save to a file which you aren't allowed to write")))))) (or buffer-backed-up (setq setmodes (backup-buffer))) (let ((dir (file-name-directory buffer-file-name))) (if (and file-precious-flag (file-writable-p dir)) ;; If file is precious, write temp name, then rename it. ;; This requires write access to the containing dir, ;; which is why we don't try it if we don't have that access. (let ((realname buffer-file-name) tempname temp nogood i succeed) (setq i 0) (setq nogood t) ;; Find the temporary name to write under. (while nogood (setq tempname (format (if (eq system-type 'vax-vms) "%s$tmp$%d" "%s#tmp#%d") dir i)) (setq nogood (file-exists-p tempname)) (setq i (1+ i))) (unwind-protect (progn (clear-visited-file-modtime) (write-region (point-min) (point-max) tempname nil realname) (setq succeed t)) ;; If writing the temp file fails, ;; delete the temp file. (or succeed (delete-file tempname))) ;; Since we have created an entirely new file ;; and renamed it, make sure it gets the ;; right permission bits set. (setq setmodes (file-modes buffer-file-name)) ;; We succeeded in writing the temp file, ;; so rename it. (rename-file tempname buffer-file-name t)) ;; If file not writable, see if we can make it writable ;; temporarily while we write it. ;; But no need to do so if we have just backed it up ;; (setmodes is set) because that says we're superseding. (cond ((and tempsetmodes (not setmodes)) ;; Change the mode back, after writing. (setq setmodes (file-modes buffer-file-name)) (set-file-modes buffer-file-name 511))) (write-region (point-min) (point-max) buffer-file-name nil t))) setmodes)) (defun save-some-buffers (&optional arg exiting) "Save some modified file-visiting buffers. Asks user about each one. Optional argument (the prefix) non-nil means save all with no questions. Optional second argument EXITING means ask about certain non-file buffers as well as about file buffers." (interactive "P") (save-window-excursion (let ((files-done (map-y-or-n-p (function (lambda (buffer) (and (buffer-modified-p buffer) (or (buffer-file-name buffer) (and exiting (progn (set-buffer buffer) (and buffer-offer-save (> (buffer-size) 0))))) (if arg t (if (buffer-file-name buffer) (format "Save file %s? " (buffer-file-name buffer)) (format "Save buffer %s? " (buffer-name buffer))))))) (function (lambda (buffer) (set-buffer buffer) (save-buffer))) (buffer-list) '("buffer" "buffers" "save") (list (list ?\C-r (lambda (buf) (view-buffer buf) (setq view-exit-action '(lambda (ignore) (exit-recursive-edit))) (recursive-edit) ;; Return nil to ask about BUF again. nil) "display the current buffer")))) (abbrevs-done (and save-abbrevs abbrevs-changed (progn (if (or arg (y-or-n-p (format "Save abbrevs in %s? " abbrev-file-name))) (write-abbrev-file nil)) ;; Don't keep bothering user if he says no. (setq abbrevs-changed nil) t)))) (or (> files-done 0) abbrevs-done (message "(No files need saving)"))))) (defun not-modified (&optional arg) "Mark current buffer as unmodified, not needing to be saved. With prefix arg, mark buffer as modified, so \\[save-buffer] will save." (interactive "P") (message (if arg "Modification-flag set" "Modification-flag cleared")) (set-buffer-modified-p arg)) (defun toggle-read-only (&optional arg) "Change whether this buffer is visiting its file read-only. With arg, set read-only iff arg is positive." (interactive "P") (setq buffer-read-only (if (null arg) (not buffer-read-only) (> (prefix-numeric-value arg) 0))) ;; Force mode-line redisplay (set-buffer-modified-p (buffer-modified-p))) (defun insert-file (filename) "Insert contents of file FILENAME into buffer after point. Set mark after the inserted text. This function is meant for the user to run interactively. Don't call it from programs! Use `insert-file-contents' instead. \(Its calling sequence is different; see its documentation)." (interactive "*fInsert file: ") (if (file-directory-p filename) (signal 'file-error (list "Opening input file" "file is a directory" filename))) (let ((tem (insert-file-contents filename))) (push-mark (+ (point) (car (cdr tem)))))) (defun append-to-file (start end filename) "Append the contents of the region to the end of file FILENAME. When called from a function, expects three arguments, START, END and FILENAME. START and END are buffer positions saying what text to write." (interactive "r\nFAppend to file: ") (write-region start end filename t)) (defun file-newest-backup (filename) "Return most recent backup file for FILENAME or nil if no backups exist." (let* ((filename (expand-file-name filename)) (file (file-name-nondirectory filename)) (dir (file-name-directory filename)) (comp (file-name-all-completions file dir)) newest) (while comp (setq file (concat dir (car comp)) comp (cdr comp)) (if (and (backup-file-name-p file) (or (null newest) (file-newer-than-file-p file newest))) (setq newest file))) newest)) (defun rename-uniquely () "Rename current buffer to a similar name not already taken. This function is useful for creating multiple shell process buffers or multiple mail buffers, etc." (interactive) (let* ((new-buf (generate-new-buffer (buffer-name))) (name (buffer-name new-buf))) (kill-buffer new-buf) (rename-buffer name) (set-buffer-modified-p (buffer-modified-p)))) ; force mode line update (defun make-directory (dir &optional parents) "Create the directory DIR and any nonexistent parent dirs. Interactively, the default choice of directory to create is the current default directory for file names. That is useful when you have visited a file in a nonexistint directory. Noninteractively, the second (optional) argument PARENTS says whether to create parent directories if they don't exist." (interactive (list (read-file-name "Make directory: " default-directory default-directory nil nil) t)) (let ((handler (find-file-name-handler dir 'make-directory))) (if handler (funcall handler 'make-directory dir parents) (if (not parents) (make-directory-internal dir) (let ((dir1 (directory-file-name (expand-file-name dir))) create-list) (while (not (file-exists-p dir1)) (setq create-list (cons (if (eq system-type 'vax-vms) dir dir1) create-list) dir (file-name-directory dir1) dir1 (directory-file-name dir))) (while create-list (make-directory-internal (car create-list)) (setq create-list (cdr create-list)))))))) (put 'revert-buffer-function 'permanent-local t) (defvar revert-buffer-function nil "Function to use to revert this buffer, or nil to do the default. The function receives two arguments IGNORE-AUTO and NOCONFIRM, which are the arguments that `revert-buffer' received.") (put 'revert-buffer-insert-file-contents-function 'permanent-local t) (defvar revert-buffer-insert-file-contents-function nil "Function to use to insert contents when reverting this buffer. Gets two args, first the nominal file name to use, and second, t if reading the auto-save file.") (defun revert-buffer (&optional ignore-auto noconfirm) "Replace the buffer text with the text of the visited file on disk. This undoes all changes since the file was visited or saved. With a prefix argument, offer to revert from latest auto-save file, if that is more recent than the visited file. When called from lisp, The first argument is IGNORE-AUTO; only offer to revert from the auto-save file when this is nil. Note that the sense of this argument is the reverse of the prefix argument, for the sake of backward compatibility. IGNORE-AUTO is optional, defaulting to nil. Optional second argument NOCONFIRM means don't ask for confirmation at all. If the value of `revert-buffer-function' is non-nil, it is called to do the work. The default revert function runs the hook `before-revert-hook' at the beginning and `after-revert-hook' at the end." ;; I admit it's odd to reverse the sense of the prefix argument, but ;; there is a lot of code out there which assumes that the first ;; argument should be t to avoid consulting the auto-save file, and ;; there's no straightforward way to encourage authors to notice a ;; reversal of the argument sense. So I'm just changing the user ;; interface, but leaving the programmatic interface the same. (interactive (list (not prefix-arg))) (if revert-buffer-function (funcall revert-buffer-function ignore-auto noconfirm) (let* ((opoint (point)) (auto-save-p (and (not ignore-auto) (recent-auto-save-p) buffer-auto-save-file-name (file-readable-p buffer-auto-save-file-name) (y-or-n-p "Buffer has been auto-saved recently. Revert from auto-save file? "))) (file-name (if auto-save-p buffer-auto-save-file-name buffer-file-name))) (cond ((null file-name) (error "Buffer does not seem to be associated with any file")) ((or noconfirm (yes-or-no-p (format "Revert buffer from file %s? " file-name))) (run-hooks 'before-revert-hook) ;; If file was backed up but has changed since, ;; we shd make another backup. (and (not auto-save-p) (not (verify-visited-file-modtime (current-buffer))) (setq buffer-backed-up nil)) ;; Get rid of all undo records for this buffer. (or (eq buffer-undo-list t) (setq buffer-undo-list nil)) (let ((buffer-read-only nil) ;; Don't make undo records for the reversion. (buffer-undo-list t)) (if revert-buffer-insert-file-contents-function (funcall revert-buffer-insert-file-contents-function file-name auto-save-p) (if (not (file-exists-p file-name)) (error "File %s no longer exists!" file-name)) ;; Bind buffer-file-name to nil ;; so that we don't try to lock the file. (let ((buffer-file-name nil)) (or auto-save-p (unlock-buffer))) (widen) (insert-file-contents file-name (not auto-save-p) nil nil t))) (goto-char (min opoint (point-max))) (after-find-file nil nil t t) (run-hooks 'after-revert-hook) t))))) (defun recover-file (file) "Visit file FILE, but get contents from its last auto-save file." (interactive (let ((prompt-file buffer-file-name) (file-name nil) (file-dir nil)) (and prompt-file (setq file-name (file-name-nondirectory prompt-file) file-dir (file-name-directory prompt-file))) (list (read-file-name "Recover file: " file-dir nil nil file-name)))) (setq file (expand-file-name file)) (if (auto-save-file-name-p (file-name-nondirectory file)) (error "%s is an auto-save file" file)) (let ((file-name (let ((buffer-file-name file)) (make-auto-save-file-name)))) (cond ((not (file-newer-than-file-p file-name file)) (error "Auto-save file %s not current" file-name)) ((save-window-excursion (if (not (eq system-type 'vax-vms)) (with-output-to-temp-buffer "*Directory*" (buffer-disable-undo standard-output) (call-process "ls" nil standard-output nil (if (file-symlink-p file) "-lL" "-l") file file-name))) (yes-or-no-p (format "Recover auto save file %s? " file-name))) (switch-to-buffer (find-file-noselect file t)) (let ((buffer-read-only nil)) (erase-buffer) (insert-file-contents file-name nil)) (after-find-file nil nil t)) (t (error "Recover-file cancelled."))))) (defun kill-some-buffers () "For each buffer, ask whether to kill it." (interactive) (let ((list (buffer-list))) (while list (let* ((buffer (car list)) (name (buffer-name buffer))) (and (not (string-equal name "")) (/= (aref name 0) ? ) (yes-or-no-p (format "Buffer %s %s. Kill? " name (if (buffer-modified-p buffer) "HAS BEEN EDITED" "is unmodified"))) (kill-buffer buffer))) (setq list (cdr list))))) (defun auto-save-mode (arg) "Toggle auto-saving of contents of current buffer. With prefix argument ARG, turn auto-saving on if positive, else off." (interactive "P") (setq buffer-auto-save-file-name (and (if (null arg) (or (not buffer-auto-save-file-name) ;; If autosave is off because buffer has shrunk, ;; then toggling should turn it on. (< buffer-saved-size 0)) (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0)))) (if (and buffer-file-name auto-save-visited-file-name (not buffer-read-only)) buffer-file-name (make-auto-save-file-name)))) ;; If -1 was stored here, to temporarily turn off saving, ;; turn it back on. (and (< buffer-saved-size 0) (setq buffer-saved-size 0)) (if (interactive-p) (message "Auto-save %s (in this buffer)" (if buffer-auto-save-file-name "on" "off"))) buffer-auto-save-file-name) (defun rename-auto-save-file () "Adjust current buffer's auto save file name for current conditions. Also rename any existing auto save file, if it was made in this session." (let ((osave buffer-auto-save-file-name)) (setq buffer-auto-save-file-name (make-auto-save-file-name)) (if (and osave buffer-auto-save-file-name (not (string= buffer-auto-save-file-name buffer-file-name)) (not (string= buffer-auto-save-file-name osave)) (file-exists-p osave) (recent-auto-save-p)) (rename-file osave buffer-auto-save-file-name t)))) (defun make-auto-save-file-name () "Return file name to use for auto-saves of current buffer. Does not consider `auto-save-visited-file-name' as that variable is checked before calling this function. You can redefine this for customization. See also `auto-save-file-name-p'." (if buffer-file-name (concat (file-name-directory buffer-file-name) "#" (file-name-nondirectory buffer-file-name) "#") ;; Deal with buffers that don't have any associated files. (Mail ;; mode tends to create a good number of these.) (let ((buffer-name (buffer-name)) (limit 0)) ;; Use technique from Sebastian Kremer's auto-save ;; package to turn slashes into \\!. This ensures that ;; the auto-save buffer name is unique. (while (string-match "[/\\]" buffer-name limit) (setq buffer-name (concat (substring buffer-name 0 (match-beginning 0)) (if (string= (substring buffer-name (match-beginning 0) (match-end 0)) "/") "\\!" "\\\\") (substring buffer-name (match-end 0)))) (setq limit (1+ (match-end 0)))) (expand-file-name (format "#%s#%s#" buffer-name (make-temp-name "")))))) (defun auto-save-file-name-p (filename) "Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'. FILENAME should lack slashes. You can redefine this for customization." (string-match "^#.*#$" filename)) (defconst list-directory-brief-switches (if (eq system-type 'vax-vms) "/NODATE/NOSIZE/NOPROTECTION/NOOWNER/NOACL" "-CF") "*Switches for list-directory to pass to `ls' for brief listing,") (defconst list-directory-verbose-switches (if (eq system-type 'vax-vms) "/PROTECTION/SIZE/DATE/OWNER/WIDTH=(FILENAME=32,SIZE=5,OWNER=10)" "-l") "*Switches for list-directory to pass to `ls' for verbose listing,") (defun list-directory (dirname &optional verbose) "Display a list of files in or matching DIRNAME, a la `ls'. DIRNAME is globbed by the shell if necessary. Prefix arg (second arg if noninteractive) means supply -l switch to `ls'. Actions controlled by variables `list-directory-brief-switches' and `list-directory-verbose-switches'." (interactive (let ((pfx current-prefix-arg)) (list (read-file-name (if pfx "List directory (verbose): " "List directory (brief): ") nil default-directory nil) pfx))) (let ((switches (if verbose list-directory-verbose-switches list-directory-brief-switches))) (or dirname (setq dirname default-directory)) (setq dirname (expand-file-name dirname)) (with-output-to-temp-buffer "*Directory*" (buffer-disable-undo standard-output) (if (not (eq system-type 'vax-vms)) (progn (princ "Directory ") (princ dirname) (terpri))) (save-excursion (set-buffer "*Directory*") (let ((wildcard (not (file-directory-p dirname)))) (insert-directory dirname switches wildcard (not wildcard))))))) (defvar insert-directory-program (if (eq system-type 'vax-vms) "DIRECTORY" "ls") "Absolute or relative name of the `ls' program used by `insert-directory'.") ;; insert-directory ;; - must insert _exactly_one_line_ describing FILE if WILDCARD and ;; FULL-DIRECTORY-P is nil. ;; The single line of output must display FILE's name as it was ;; given, namely, an absolute path name. ;; - must insert exactly one line for each file if WILDCARD or ;; FULL-DIRECTORY-P is t, plus one optional "total" line ;; before the file lines, plus optional text after the file lines. ;; Lines are delimited by "\n", so filenames containing "\n" are not ;; allowed. ;; File lines should display the basename. ;; - must be consistent with ;; - functions dired-move-to-filename, (these two define what a file line is) ;; dired-move-to-end-of-filename, ;; dired-between-files, (shortcut for (not (dired-move-to-filename))) ;; dired-insert-headerline ;; dired-after-subdir-garbage (defines what a "total" line is) ;; - variable dired-subdir-regexp (defun insert-directory (file switches &optional wildcard full-directory-p) "Insert directory listing for FILE, formatted according to SWITCHES. Leaves point after the inserted text. SWITCHES may be a string of options, or a list of strings. Optional third arg WILDCARD means treat FILE as shell wildcard. Optional fourth arg FULL-DIRECTORY-P means file is a directory and switches do not contain `d', so that a full listing is expected. This works by running a directory listing program whose name is in the variable `insert-directory-program'. If WILDCARD, it also runs the shell specified by `shell-file-name'. On VMS, if FILE ends with a semicolon, only the highest version will be inserted." ;; We need the directory in order to find the right handler. (let ((handler (find-file-name-handler (expand-file-name file) 'insert-directory))) (if handler (funcall handler 'insert-directory file switches wildcard full-directory-p) (if (eq system-type 'vax-vms) ;; Run ls in the directory of the file pattern we asked for. (let ((default-directory (file-name-directory (expand-file-name file)))) (call-process insert-directory-program nil t nil switches file)) (if wildcard ;; Run ls in the directory of the file pattern we asked for. (let ((default-directory (if (file-name-absolute-p file) (file-name-directory file) (file-name-directory (expand-file-name file)))) (pattern (file-name-nondirectory file)) (beg 0)) ;; Quote some characters that have special meanings in shells; ;; but don't quote the wildcards--we want them to be special. ;; We also currently don't quote the quoting characters ;; in case people want to use them explicitly to quote ;; wildcard characters. (while (string-match "[ \t\n;<>&|()#$]" pattern beg) (setq pattern (concat (substring pattern 0 (match-beginning 0)) "\\" (substring pattern (match-beginning 0))) beg (1+ (match-end 0)))) (call-process shell-file-name nil t nil "-c" (concat insert-directory-program " -d " (if (stringp switches) switches (mapconcat 'identity switches " ")) " " pattern))) ;; SunOS 4.1.3, SVr4 and others need the "." to list the ;; directory if FILE is a symbolic link. (apply 'call-process insert-directory-program nil t nil (let (list) (if (listp switches) (setq list switches) (if (not (equal switches "")) (progn ;; Split the switches at any spaces ;; so we can pass separate options as separate args. (while (string-match " " switches) (setq list (cons (substring switches 0 (match-beginning 0)) list) switches (substring switches (match-end 0)))) (setq list (cons switches list))))) (append list (list (if full-directory-p (concat (file-name-as-directory file) ".") file)))))))))) (defvar kill-emacs-query-functions nil "Functions to call with no arguments to query about killing Emacs. If any of these functions returns nil, killing Emacs is cancelled.") (defun save-buffers-kill-emacs (&optional arg) "Offer to save each buffer, then kill this Emacs process. With prefix arg, silently save all file-visiting buffers, then kill." (interactive "P") (save-some-buffers arg t) (and (or (not (memq t (mapcar (function (lambda (buf) (and (buffer-file-name buf) (buffer-modified-p buf)))) (buffer-list)))) (yes-or-no-p "Modified buffers exist; exit anyway? ")) (or (not (fboundp 'process-list)) ;; process-list is not defined on VMS. (let ((processes (process-list)) active) (while processes (and (memq (process-status (car processes)) '(run stop open)) (let ((val (process-kill-without-query (car processes)))) (process-kill-without-query (car processes) val) val) (setq active t)) (setq processes (cdr processes))) (or (not active) (yes-or-no-p "Active processes exist; kill them and exit anyway? ")))) ;; Query the user for other things, perhaps. (let ((functions kill-emacs-query-functions) (yes t)) (while (and functions yes) (setq yes (and yes (funcall (car functions)))) (setq functions (cdr functions))) yes) (kill-emacs))) (define-key ctl-x-map "\C-f" 'find-file) (define-key ctl-x-map "\C-q" 'toggle-read-only) (define-key ctl-x-map "\C-r" 'find-file-read-only) (define-key ctl-x-map "\C-v" 'find-alternate-file) (define-key ctl-x-map "\C-s" 'save-buffer) (define-key ctl-x-map "s" 'save-some-buffers) (define-key ctl-x-map "\C-w" 'write-file) (define-key ctl-x-map "i" 'insert-file) (define-key esc-map "~" 'not-modified) (define-key ctl-x-map "\C-d" 'list-directory) (define-key ctl-x-map "\C-c" 'save-buffers-kill-emacs) (define-key ctl-x-4-map "f" 'find-file-other-window) (define-key ctl-x-4-map "r" 'find-file-read-only-other-window) (define-key ctl-x-4-map "\C-f" 'find-file-other-window) (define-key ctl-x-4-map "b" 'switch-to-buffer-other-window) (define-key ctl-x-4-map "\C-o" 'display-buffer) (define-key ctl-x-5-map "b" 'switch-to-buffer-other-frame) (define-key ctl-x-5-map "f" 'find-file-other-frame) (define-key ctl-x-5-map "\C-f" 'find-file-other-frame) (define-key ctl-x-5-map "r" 'find-file-read-only-other-frame) ;;; files.el ends here ap "f" 'find-file-other-window) (define-key ctl-x-4-map "r" 'find-file-read-only-other-window) (define-key ctl-x-4-map "\C-f" 'find-file-other-window) (define-key ctl-x-4-map "b" 'switch-to-buffer-other-window) (define-key ctl-x-4-map "\C-o" 'display-buffer) (define-key ctl-x-5-map "b" 'switch-to-buffer-other-frame) (define-key ctl-x-5-map "f" 'find-file-other-frame) (define-key emacs-19_28/lisp/files.elc 644 23 204 154370 6027634703 10547 ;ELC ;;; compiled by LEVITTE@eliza.e.kth.se on Tue Sep 19 10:31:37 1995 ;;; from file ED1928:[LISP]FILES.EL ;;; emacs version 19.28.97. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`ED1928:[LISP]FILES.EL' was compiled for Emacs 19")) (defconst delete-auto-save-files t "\ *Non-nil means delete auto-save file when a buffer is saved or killed.") (defconst directory-abbrev-alist nil "\ *Alist of abbreviations for file directories. A list of elements of the form (FROM . TO), each meaning to replace FROM with TO when it appears in a directory name. This replacement is done when setting up the default directory of a newly visited file. *Every* FROM string should start with `^'. Do not use `~' in the TO strings. They should be ordinary absolute directory names. Use this feature when you have directories which you normally refer to via absolute symbolic links. Make TO the name of the link, and FROM the name it is linked to.") (defconst make-backup-files (byte-code "Á=?‡" [system-type vax-vms] 2) "\ *Non-nil means make a backup of a file the first time it is saved. This can be done by renaming the file or by copying. Renaming means that Emacs renames the existing file so that it is a backup file, then writes the buffer into a new file. Any other names that the old file had will now refer to the backup file. The new file is owned by you and its group is defaulted. Copying means that Emacs copies the existing file into the backup file, then writes the buffer on top of the existing file. Any other names that the old file had will now refer to the new (edited) file. The file's owner and group are unchanged. The choice of renaming or copying is controlled by the variables `backup-by-copying', `backup-by-copying-when-linked' and `backup-by-copying-when-mismatch'. See also `backup-inhibited'.") (defvar backup-inhibited nil "\ Non-nil means don't make a backup, regardless of the other parameters. This variable is intended for use by making it local to a buffer. But it is local only if you make it local.") (put (quote backup-inhibited) (quote permanent-local) t) (defconst backup-by-copying nil "\ *Non-nil means always use copying to create backup files. See documentation of variable `make-backup-files'.") (defconst backup-by-copying-when-linked nil "\ *Non-nil means use copying to create backups for files with multiple names. This causes the alternate names to refer to the latest version as edited. This variable is relevant only if `backup-by-copying' is nil.") (defconst backup-by-copying-when-mismatch nil "\ *Non-nil means create backups by copying if this preserves owner or group. Renaming may still be used (subject to control of other variables) when it would not result in changing the owner or group of the file; that is, for files which are owned by you and whose group matches the default for a new file created there by you. This variable is relevant only if `backup-by-copying' is nil.") (defvar backup-enable-predicate (quote (lambda (name) (or (< (length name) 5) (not (string-equal "/tmp/" (substring name 0 5)))))) "\ Predicate that looks at a file name and decides whether to make backups. Called with an absolute file name as argument, it returns t to enable backup.") (defconst buffer-offer-save nil "\ *Non-nil in a buffer means offer to save the buffer on exit even if the buffer is not visiting a file. Automatically local in all buffers.") (make-variable-buffer-local (quote buffer-offer-save)) (defconst find-file-existing-other-name nil "\ *Non-nil means find a file under alternative names, in existing buffers. This means if any existing buffer is visiting the file you want under another name, you get the existing buffer instead of a new buffer.") (defconst find-file-visit-truename nil "\ *Non-nil means visit a file under its truename. The truename of a file is found by chasing all links both at the file level and at the levels of the containing directories.") (defvar buffer-file-truename nil "\ The abbreviated truename of the file visited in the current buffer. That is, (abbreviated-file-name (file-truename buffer-file-name)). This variable is automatically local in all buffers, when non-nil.") (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local buffer-file-truename put permanent-local t] 4) (defvar buffer-file-number nil "\ The device number and file number of the file visited in the current buffer. The value is a list of the form (FILENUM DEVNUM). This pair of numbers uniquely identifies the file. If the buffer is visiting a new file, the value is nil.") (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local buffer-file-number put permanent-local t] 4) (defconst file-precious-flag nil "\ *Non-nil means protect against I/O errors while saving files. Some modes set this non-nil in particular buffers.") (defvar version-control nil "\ *Control use of version numbers for backup files. t means make numeric backup versions unconditionally. nil means make them for files that have some already. `never' means do not make them.") (defvar dired-kept-versions 2 "\ *When cleaning directory, number of versions to keep.") (defvar delete-old-versions nil "\ *If t, delete excess backup versions silently. If nil, ask confirmation. Any other value prevents any trimming.") (defvar kept-old-versions 2 "\ *Number of oldest versions to keep when a new numbered backup is made.") (defvar kept-new-versions 2 "\ *Number of newest versions to keep when a new numbered backup is made. Includes the new backup. Must be > 0") (defconst require-final-newline nil "\ *Value of t says silently ensure a file ends in a newline when it is saved. Non-nil but not t says ask user whether to add a newline when there isn't one. nil means don't add newlines.") (defconst auto-save-default t "\ *Non-nil says by default do auto-saving of every file-visiting buffer.") (defconst auto-save-visited-file-name nil "\ *Non-nil says auto-save a buffer in the file it is visiting, when practical. Normally auto-save files are written under other names.") (defconst save-abbrevs nil "\ *Non-nil means save word abbrevs too when files are saved. Loading an abbrev file sets this to t.") (defconst find-file-run-dired t "\ *Non-nil says run dired if `find-file' is given the name of a directory.") (defvar find-file-not-found-hooks nil "\ List of functions to be called for `find-file' on nonexistent file. These functions are called as soon as the error is detected. `buffer-file-name' is already set up. The functions are called in the order given until one of them returns non-nil.") (defvar find-file-hooks nil "\ List of functions to be called after a buffer is loaded from a file. The buffer's local variables (if any) will have been processed before the functions are called.") (defvar write-file-hooks nil "\ List of functions to be called before writing out a buffer to a file. If one of them returns non-nil, the file is considered already written and the rest are not called. These hooks are considered to pertain to the visited file. So this list is cleared if you change the visited file name. See also `write-contents-hooks'. Don't make this variable buffer-local; instead, use `local-write-file-hooks'.") (put (quote write-file-hooks) (quote permanent-local) t) (defvar local-write-file-hooks nil "\ Just like `write-file-hooks', except intended for per-buffer use. The functions in this list are called before the ones in `write-file-hooks'.") (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local local-write-file-hooks put permanent-local t] 4) (defvar write-contents-hooks nil "\ List of functions to be called before writing out a buffer to a file. If one of them returns non-nil, the file is considered already written and the rest are not called. These hooks are considered to pertain to the buffer's contents, not to the particular visited file; thus, `set-visited-file-name' does not clear this variable, but changing the major mode does clear it. See also `write-file-hooks'.") (defconst enable-local-variables t "\ *Control use of local-variables lists in files you visit. The value can be t, nil or something else. A value of t means local-variables lists are obeyed; nil means they are ignored; anything else means query. The command \\[normal-mode] always obeys local-variables lists and ignores this variable.") (defconst enable-local-eval (quote maybe) "\ *Control processing of the \"variable\" `eval' in a file's local variables. The value can be t, nil or something else. A value of t means obey `eval' variables; nil means ignore them; anything else means query. The command \\[normal-mode] always obeys local-variables lists and ignores this variable.") (byte-code "ÀÁ!„ ÂÁÃ\"ˆÀÄ!„ÂÄÃ\"ˆÂÅÆ\"‡" [fboundp lock-buffer defalias ignore unlock-buffer ange-ftp-completion-hook-function #[(op &rest args) "Á>ƒ\fÂÃ\f#‡Å=…BÂ\f\"*‡" [op (file-name-completion file-name-all-completions) apply ange-ftp-hook-function args ange-ftp-completion-hook-function inhibit-file-name-operation inhibit-file-name-handlers] 4]] 3) (defalias 'pwd #[nil "ÀÁ\n\"‡" [message "Directory %s" default-directory] 3 "\ Show the current default directory." nil]) (defvar cd-path nil "\ Value of the CDPATH environment variable, as a list. Not actually set up until the first time you you use it.") (defalias 'parse-colon-path #[(cd-path) "…7Á‰ÂÁÇPÈÇ\f#‰ƒ5 \f U?…+ÉÊ\f O!!C¤ Ë\\‚ ,‡" [cd-path nil 0 cd-colon cd-start cd-list cd-prefix ":" string-match substitute-in-file-name file-name-as-directory 1] 6 "\ Explode a colon-separated list of paths into a string list."]) (defalias 'cd-absolute #[(dir) "Á=„\n !ÄÅ !!Æ !„ÇÈ \"‡É !ƒ& ‰\n‡ÇË \"‡" [system-type vax-vms file-name-as-directory dir abbreviate-file-name expand-file-name file-directory-p error "%s is not a directory" file-executable-p default-directory "Cannot cd to %s: Permission denied"] 3 "\ Change current directory to given absolute file name DIR."]) (defalias 'cd #[(dir) "À !ƒ\fÂà !!‡\f„'ÅÆÇ!!‰†% Ê>?…%ËC)ÌÍ?…1ÎÏ!‡" [file-name-absolute-p dir cd-absolute expand-file-name cd-path parse-colon-path getenv "CDPATH" trypath system-type (vax-vms axp-vms) "./" found (byte-code "ÀÁ\n\"ˆ Ä>…$ÅÆ!!É!…#Ê!ˆËÌÍ\")‡" [mapcar #[(x) "À \nP!Ä !…Å !ˆÆÇÈ\")‡" [expand-file-name x dir f file-directory-p cd-absolute throw found t] 3] cd-path system-type (vax-vms axp-vms) expand-file-name file-name-as-directory dir f file-directory-p cd-absolute throw found t] 3) error "No such directory found via CDPATH environment variable"] 4 "\ Make DIR become the current buffer's default directory. If your environment includes a `CDPATH' variable, try each one of that colon-separated list of directories when resolving a relative directory name." "FChange default directory: "]) (defalias 'load-file #[(file) "ÀÁ\n!ÉÄ$‡" [load expand-file-name file nil t] 5 "\ Load the Lisp file named FILE." "fLoad file: "]) (defalias 'load-library #[(library) "À !‡" [load library] 2 "\ Load the library named LIBRARY. This is an interface to the function `load'." "sLoad library: "]) (defalias 'file-local-copy #[(file &optional buffer) "À Â\"‰…  \")‡" [find-file-name-handler file file-local-copy handler] 4 "\ Copy the file FILE into a temporary file on this machine. Returns the name of the local copy, or nil, if FILE is directly accessible."]) (defalias 'file-truename #[(filename &optional counter prev-dirs) "Á˜„ÂÃOÁ˜ƒ\"ÄÅ\"ƒ\"Æ!‰ǘƒ\"È „+ÊC Ë\fƒ6 ‚FÎ !ÐÑÒ\"\") \f„SËC\f„. ‰@S ˆ @ÂWƒlÔÕ\"ˆÖ×\"‰ƒ‚×\"Ù‚*Ú!ˉÞ!˜„Ôß\f@\"ƒ²ß\f@\"A‚Ôà× \f#!!\"\f\"!B\f@B ˆ!*ã!䚃ëÞÚÞ!!!Ù‚)ã!嚃þÞ!Ù‚)ã!Pæ!‰ƒ&ç!ƒ‚PË‚)Ù+)‚S*‡" [filename "~" 0 1 string-match "~[^/]*" expand-file-name "" "/" counter 100 nil prev-dirs file-name-handler-alist copy-sequence tem delq rassq ange-ftp-completion-hook-function done error "Apparent cycle of symbolic links for %s" find-file-name-handler file-truename handler t file-name-directory dirfile target dir directory-file-name assoc file-name-as-directory new old file-name-nondirectory ".." "." file-symlink-p file-name-absolute-p] 7 "\ Return the truename of FILENAME, which should be absolute. The truename of a file name is found by chasing symbolic links both at the level of the file and at the level of the directories containing it, until no links are left at any level. The arguments COUNTER and PREV-DIRS are used only in recursive calls. Do not specify them in other calls."]) (defalias 'file-chase-links #[(filename) "ÀÁ\nÆ !‰ƒZ\fÇUƒÈÉ\n\"ˆÊË \"ƒ0 lj”TO Ç•ÀOP‚ÊÌ \"ƒM ÍÀOÎÏÐÑÏÐ !!!!!!‚0Ò Ð !\"\fS‚ +‡" [nil 100 filename newname count tem file-symlink-p 0 error "Apparent cycle of symbolic links for %s" string-match "//+" "\\`\\.\\./" 3 file-name-as-directory directory-file-name file-name-directory file-chase-links expand-file-name] 7 "\ Chase links in FILENAME until a name that is not a link. Does not examine containing directories for links, unlike `file-truename'."]) (defalias 'switch-to-buffer-other-window #[(buffer) "À À\")‡" [t pop-up-windows pop-to-buffer buffer] 3 "\ Select buffer BUFFER in another window." "BSwitch to buffer in other window: "]) (defalias 'switch-to-buffer-other-frame #[(buffer) "À À\"ˆÄÅÆ !!)‡" [t pop-up-frames pop-to-buffer buffer raise-frame window-frame selected-window] 3 "\ Switch to buffer BUFFER in another frame." "BSwitch to buffer in other frame: "]) (defalias 'find-file #[(filename) "ÀÁ\n!!‡" [switch-to-buffer find-file-noselect filename] 3 "\ Edit file FILENAME. Switch to a buffer visiting file FILENAME, creating one if none already exists." "FFind file: "]) (defalias 'find-file-other-window #[(filename) "ÀÁ\n!!‡" [switch-to-buffer-other-window find-file-noselect filename] 3 "\ Edit file FILENAME, in another window. May create a new window, or reuse an existing one. See the function `display-buffer'." "FFind file in other window: "]) (defalias 'find-file-other-frame #[(filename) "ÀÁ\n!!‡" [switch-to-buffer-other-frame find-file-noselect filename] 3 "\ Edit file FILENAME, in another frame. May create a new frame, or reuse an existing one. See the function `display-buffer'." "FFind file in other frame: "]) (defalias 'find-file-read-only #[(filename) "À !ˆÂp‡" [find-file filename t buffer-read-only] 2 "\ Edit file FILENAME but don't allow changes. Like \\[find-file] but marks buffer as read-only. Use \\[toggle-read-only] to permit editing." "fFind file read-only: "]) (defalias 'find-file-read-only-other-window #[(filename) "À !ˆÂp‡" [find-file-other-window filename t buffer-read-only] 2 "\ Edit file FILENAME in another window but don't allow changes. Like \\[find-file-other-window] but marks buffer as read-only. Use \\[toggle-read-only] to permit editing." "fFind file read-only other window: "]) (defalias 'find-file-read-only-other-frame #[(filename) "À !ˆÂp‡" [find-file-other-frame filename t buffer-read-only] 2 "\ Edit file FILENAME in another frame but don't allow changes. Like \\[find-file-other-frame] but marks buffer as read-only. Use \\[toggle-read-only] to permit editing." "fFind file read-only other frame: "]) (defalias 'find-alternate-file #[(filename) "À ƒÁÂÃÄ \"!„ÅÆ!ˆp Ä \n \f ÏÐ!ˆÑÑÑ ÒŽÓ ˆÔ!ˆ)p=†IÖ!-‡" [buffer-modified-p yes-or-no-p format "Buffer %s is modified; kill anyway? " buffer-name error "Aborted" buffer-file-name buffer-file-number buffer-file-truename oname otrue onum ofile obuf rename-buffer " **lose**" nil ((byte-code "p=ƒ   Ç ˆÈ !ˆÇ‡" [obuf ofile buffer-file-name onum buffer-file-number otrue buffer-file-truename lock-buffer rename-buffer oname] 2)) unlock-buffer find-file filename kill-buffer] 5 "\ Find file FILENAME, select its buffer, kill previous buffer. If the current buffer now contains an empty file that you just visited (presumably by mistake), use this command to visit the file you really want." (byte-code "Á‰‰ƒÅ\f!Æ\f!ÇÈ\nÁ‰ %+C‡" [buffer-file-name nil file-dir file-name file file-name-nondirectory file-name-directory read-file-name "Find alternate file: "] 7)]) (defalias 'create-file-buffer #[(filename) "À !‰؃\f Ä\n!)‡" [file-name-nondirectory filename lastname "" generate-new-buffer] 3 "\ Create a suitably named buffer for visiting FILENAME, and return it. FILENAME (sans directory) is used unchanged if that name is free; otherwise a string <2> or <3> or ... is appended to get an unused name."]) (defalias 'generate-new-buffer #[(name) "ÀÁ\n!!‡" [get-buffer-create generate-new-buffer-name name] 3 "\ Create and return a buffer with a name based on NAME. Choose the buffer's name using `generate-new-buffer-name'."]) (defconst automount-dir-prefix "^/tmp_mnt/" "\ Regexp to match the automounter prefix in a directory name.") (defvar abbreviated-home-dir nil "\ The user's homedir abbreviated according to `directory-abbrev-list'.") (defalias 'abbreviate-file-name #[(filename) "À \n\"ƒÃÄ\nÅ•SÆO!!ƒ\nÅ•SÆO‰ƒAÀ@@\n\"ƒ8@A\nÅ•ÆOPA‰„# „TÊ ËÌÍÎ!!ÏQ) À \n\"ƒŽÅ•ÐUƒk\nÅHÑU„ŽÓ=ƒ€Ô ÖŽÀ×\n\"*„ŽÎ\nДЕO\nÅ•ÆOQ\n)‡" [string-match automount-dir-prefix filename file-exists-p file-name-directory 0 nil directory-abbrev-alist tail abbreviated-home-dir "$foo" "^" abbreviate-file-name expand-file-name "~" "\\(/\\|$\\)" 1 47 system-type ms-dos match-data match-data ((store-match-data match-data)) "^[a-zA-Z]:/$"] 6 "\ Return a version of FILENAME shortened using `directory-abbrev-alist'. This also substitutes \"~\" for the user's home directory. Type \\[describe-variable] directory-abbrev-alist RET for more information."]) (defvar find-file-not-true-dirname-list nil "\ *List of logical names for which visiting shouldn't save the true dirname. On VMS, when you visit a file using a logical name that searches a path, you may or may not want the visited file name to record the specific directory where the file was found. If you *do not* want that, add the logical name to this list as a string.") (defalias 'find-buffer-visiting #[(filename) "À !Âà !!‰†˜Æ Ç „? ƒ?Š @qˆ\nƒ6 \f˜ƒ6 @) A ‚*†˜ÌÍ\f!›Æ Ç ‰ƒ•„• ƒ•Š @qˆ\nƒŒšƒŒÐ\n!ƒŒÌÍ\n!›šƒŒ @) A ‚W+*‡" [get-file-buffer filename abbreviate-file-name file-truename truename buf buffer-list nil found list buffer-file-name buffer-file-truename 10 file-attributes number buffer-file-number file-exists-p] 5 "\ Return the buffer visiting file FILENAME (a string). This is like `get-file-buffer', except that it checks for any buffer visiting the same file, possibly under a different name. If there is no such live buffer, return nil."]) (defvar find-file-expand-completelly-list nil "\ *List of logicals names which should be completelly expanded. On VMS, vms-expand-search-paths will normally expand paths until it is unique, that is until the device name only designates one place. There might be cases, though, when you want the logical names to be expanded completelly, and only get a real device name as device. In that case, add that logical name to this list.") (defalias (quote file-truename-wrap) #[(filename) "Á=ƒ ÄÅÆ !\"…Æ !lj”O\"‡Â !‡" [system-type vax-vms file-truename filename string-match ":" file-name-directory 0 find-file-expand-completelly-list] 6]) (defalias 'find-file-noselect #[(filename &optional nowarn) "ÀÁ\n!!Ã\n!ƒ\fƒÅ\n!‡ÆÇ\n\"‡È\n! ÀÊ\n!! ÌÍ !› ?…6Ï\n!уe„W\nÓ!˜„WÔÕ\nÓ!#ˆ„aƒe  ƒ¨„Ø !„Ù\n!„„ÆÚ\n\"ˆ‚ÛÜÝ !ƒ‘Þ‚’ßà\n!\"!ƒŠ qˆáâ‰\"ˆ)‚Šã\n!‰ qˆä ˆÑåæˆ '()ê=ƒêÑ+ìíî\n!\"ƒÝî\n!O++0)„ê'ƒ÷Á'!‰î\n!12!„ óô!ˆâ4õ?\"ˆ) -‡" [abbreviate-file-name expand-file-name filename file-directory-p find-file-run-dired dired-noselect error "%s is a directory." get-file-buffer buf file-truename-wrap truename 10 file-attributes number find-buffer-visiting other nil nowarn buffer-file-name message "%s and %s are the same file" find-file-existing-other-name find-file-visit-truename verify-visited-file-modtime file-exists-p "File %s no longer exists!" yes-or-no-p format buffer-modified-p "File %s changed on disk. Discard your edits? " "File %s changed on disk. Reread from disk? " file-name-nondirectory revert-buffer t create-file-buffer erase-buffer (insert-file-contents filename t) ((file-error (byte-code "À\n‰ƒ @ ƒÄ‚ A‰„)ć" [t error find-file-not-found-hooks hooks nil] 2))) buffer-file-truename buffer-file-number system-type vax-vms logical string-match ":" file-name-directory 0 find-file-not-true-dirname-list default-directory backup-enable-predicate make-local-variable backup-inhibited after-find-file] 6 "\ Read file FILENAME into a buffer and return the buffer. If a buffer exists visiting FILENAME, return that one, but verify that the file has not changed since visited or saved. The buffer is not selected, just returned to the caller."]) (byte-code "ÀÁ!„‡" [boundp after-find-file-from-revert-buffer nil] 2) (defalias 'after-find-file #[(&optional error warn noauto after-find-file-from-revert-buffer) "À !? „™ÄƒÇ !ƒÈÉ‚u\n„<\nƒ1ËÌ \"ƒ1Í‚uÈ…u΂u„GÈÏ‚uÇÐ!!ƒTÒ‚uÓÔ !!ƒbĉ‚uÄÓÔÐÔ !!!!ƒtÕ‚uÖ‰ƒŠØ!ˆ „ŠÙÚÄÈ#ˆ*ƒ™„™ÝÈ!ˆÞÈ!ˆßà!\"‡" [file-writable-p buffer-file-name buffer-read-only noninteractive nil not-serious error file-attributes t "File exists, but cannot be read." warn file-newer-than-file-p make-auto-save-file-name "Auto save file is newer; consider M-x recover-file" "(New file)" "Note: file is write protected" directory-file-name default-directory "File not found and directory write-protected" file-exists-p file-name-directory "Use M-x make-dir RET RET to create the directory" "Use C-u M-x make-dir RET RET to create directory and its parents" msg message sit-for 1 auto-save-default noauto auto-save-mode normal-mode mapcar funcall find-file-hooks] 6 "\ Called after finding a file and by the default revert function. Sets buffer mode, parses local variables. Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an error in reading the file. WARN non-nil means warn if there exists an auto-save file more recent than the visited file. NOAUTO means don't mess with auto-save mode. Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER non-nil means this call was from `revert-buffer'. Finishes by calling the functions in `find-file-hooks'."]) (defalias 'normal-mode #[(&optional find-file) "„ †  ˆÃÄňÃÆLJ" [find-file default-major-mode fundamental-mode err (set-auto-mode) ((error (byte-code "ÀÁ !\"‡" [message "File mode specification error: %s" prin1-to-string err] 4))) (byte-code "?†  )‡" [find-file enable-local-variables hack-local-variables] 1) ((error (byte-code "ÀÁ !\"‡" [message "File local-variables error: %s" prin1-to-string err] 4)))] 3 "\ Choose the major mode for this buffer automatically. Also sets up any specified local variables of the file. Uses the visited file name, the -*- line, and the local variables spec. This function is called automatically from `find-file'. In that case, we may set up specified local variables depending on the value of `enable-local-variables': if it is t, we do; if it is nil, we don't; otherwise, we query. `enable-local-variables' is ignored if you run `normal-mode' explicitly." nil]) (defvar auto-mode-alist (mapcar (quote purecopy) (quote (("\\.text\\'" . text-mode) ("\\.c\\'" . c-mode) ("\\.h\\'" . c-mode) ("\\.tex\\'" . TeX-mode) ("\\.ltx\\'" . LaTeX-mode) ("\\.el\\'" . emacs-lisp-mode) ("\\.mm\\'" . nroff-mode) ("\\.me\\'" . nroff-mode) ("\\.ms\\'" . nroff-mode) ("\\.man\\'" . nroff-mode) ("\\.scm\\'" . scheme-mode) ("\\.l\\'" . lisp-mode) ("\\.lisp\\'" . lisp-mode) ("\\.f\\'" . fortran-mode) ("\\.for\\'" . fortran-mode) ("\\.p\\'" . pascal-mode) ("\\.pas\\'" . pascal-mode) ("\\.mss\\'" . scribe-mode) ("\\.pl\\'" . prolog-mode) ("\\.cc\\'" . c++-mode) ("\\.hh\\'" . c++-mode) ("\\.C\\'" . c++-mode) ("\\.H\\'" . c++-mode) ("\\.texinfo\\'" . texinfo-mode) ("\\.texi\\'" . texinfo-mode) ("\\.s\\'" . asm-mode) ("ChangeLog\\'" . change-log-mode) ("change.log\\'" . change-log-mode) ("changelo\\'" . change-log-mode) ("ChangeLog.[0-9]+\\'" . change-log-mode) ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode) ("\\.[12345678]\\'" . nroff-mode) ("\\.TeX\\'" . TeX-mode) ("\\.sty\\'" . LaTeX-mode) ("\\.bbl\\'" . LaTeX-mode) ("\\.bib\\'" . bibtex-mode) ("\\.article\\'" . text-mode) ("\\.letter\\'" . text-mode) ("\\.tcl\\'" . tcl-mode) ("\\.lsp\\'" . lisp-mode) ("\\.awk\\'" . awk-mode) ("\\.prolog\\'" . prolog-mode) ("\\.tar\\'" . tar-mode) ("^/tmp/Re" . text-mode) ("/Message[0-9]*\\'" . text-mode) ("^/tmp/fol/" . text-mode) ("\\.y\\'" . c-mode) ("\\.lex\\'" . c-mode) ("\\.oak\\'" . scheme-mode) ("\\.scm.[0-9]*\\'" . scheme-mode) ("\\.sgm\\'" . sgml-mode) ("\\.sgml\\'" . sgml-mode) ("\\.dtd\\'" . sgml-mode) ("[]>:/]\\..*emacs\\'" . emacs-lisp-mode) ("[:/]_emacs\\'" . emacs-lisp-mode) ("\\.ml\\'" . lisp-mode)))) "\ Alist of filename patterns vs corresponding major mode functions. Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION). Visiting a file whose name matches REGEXP causes FUNCTION to be called. If the element has the form (REGEXP FUNCTION), then after calling FUNCTION, we delete the suffix that matched REGEXP and search the list again for another match.") (defconst interpreter-mode-alist (quote (("perl" . perl-mode) ("wish" . tcl-mode) ("wishx" . tcl-mode) ("tcl" . tcl-mode) ("tclsh" . tcl-mode) ("awk" . awk-mode) ("gawk" . awk-mode) ("scm" . scheme-mode))) "\ Alist mapping interpreter names to major modes. This alist applies to files whose first line starts with `#!'. Each element looks like (INTERPRETER . MODE). The car of each element is compared with the name of the interpreter specified in the first line. If it matches, mode MODE is selected.") (defconst inhibit-first-line-modes-regexps (quote ("\\.tar$")) "\ List of regexps; if one matches a file name, don't look for `-*-'.") (defvar user-init-file "" "\ File name including directory of user's initialization file.") (defalias 'set-auto-mode #[nil "À‰‰ŠebˆÄÀwˆ ƒ¯‰ƒ-È@ \"„-A‰„)„¯ÊËŠÌÍ!…=Έ`)Ï#ƒ¯ÐÀwˆ`ÊËŠÀˆ`)Ï#ƒ¯ÑuˆÐÀxˆ` bˆŠÊÒ\nÏ#)ƒ£ÏÊÔ\nÏ#)ƒ­ÐÀwˆ`ÊÕ\nÏ#ƒÖuˆ‚’\nbˆÐÀxˆ× `{—ØP! ˆ‚o× \n{—ØP! ˆÏ ?…e …e ÏÛ!…dÀÀà=„&ƒ&È@@\"ƒ@A:ƒÎ@8ƒ@A@ቔOÏ‚@AÀA‚Û)ƒ3 ˆ‚`ŠebˆÌâ!ƒEã”ã•{‚Fä)À%&çè&!)\"‰%ƒ_%A ˆ**‚Æ*,‡" [nil done end beg " \n" enable-local-variables inhibit-first-line-modes-regexps temp string-match buffer-file-name search-forward "-*-" looking-at "^#!" 2 t " " -3 ":" case-fold-search "mode:" ";" -1 intern "-mode" keep-going name file-name-sans-versions auto-mode-alist mode alist system-type vax-vms 0 "#! *\\([^ \n]+\\)" 1 "" elt interpreter assoc file-name-nondirectory interpreter-mode-alist] 5 "\ Select major mode appropriate for current buffer. This checks for a -*- mode tag in the buffer's text, compares the filename against the entries in `auto-mode-alist', or checks the interpreter that runs this file against `interpreter-mode-alist'. It does not check for the `mode:' local variable in the Local Variables section of the file; for that, use `hack-local-variables'. If `enable-local-variables' is nil, this function does not check for a -*- mode tag."]) (defalias (quote hack-local-variables-prop-line) #[nil "ŠebˆÀŠÁÂ!… È`)ÆÇ\fÈ#ƒxÁÉ!„xŠÆÇ\fÈ#ƒ1`ÊZ‚5ËÌ!ˆ)`\fWƒuÁÍ!„FËÎ!ˆÏ•bˆÐєѕ{—!Œ`\f}ˆÒp!)‰Õ=„mB BÖÀwˆ*‚6 Ÿ …¢È=„…¢Ø‹…¢ …¢Ù @@ @A\"ˆ A‰„‘À+‡" [nil looking-at "^#!" 2 end result search-forward "-*-" t "[ ]*\\([^ \n :;]+\\)\\([ ]*-\\*-\\)" 3 error "-*- not terminated before end of line" "[ ]*\\([^ \n:]+\\)[ ]*:[ ]*" "malformed -*- line" 0 intern 1 read val key mode " ;" enable-local-variables ((byte-code "ÀÁˆÃÄÅÆ!\"!‡" [nil (byte-code "Àp!‡" [switch-to-buffer] 2) ((error (byte-code "ÀÁ‡" [nil (byte-code "Àp!‡" [switch-to-buffer-other-window] 2) ((error (byte-code "Àp!‡" [switch-to-buffer-other-frame] 2)))] 3))) y-or-n-p format "Set local variables as specified in -*- line of %s? " file-name-nondirectory buffer-file-name] 5)) hack-one-local-variable] 5]) (defalias 'hack-local-variables #[nil "À ˆŠdbˆÁÂdÃZe]Ä#ˆÅÇÈÉÅ#…*\nÅ=†*\n…*Ë‹)…Åɉ‰‰\f\f ÒÉwˆl„Q`Ɉ`{Ó”bˆn„a`Óyˆ`{ƒqGÔ!ƒ~Ô!ÕP…ƒ×Ø!ˆ‚’Ùyˆƒ©Ú!ƒ¥uˆ‚©ÛÜ!ˆÒÉwˆ` ÝÉwˆlƒ¼ÛÞ!ˆÒÉxˆ `{à!!É\"—㘃ÝÉ‚\fäÉwˆÙuˆàp!\"åÉxˆÒÉwˆƒýÚ!‚þl„Ûæ!ˆç!\"\"ˆ+‚~.)‡" [hack-local-variables-prop-line search-backward "\n\f" 3000 move t case-fold-search search-forward "Local Variables:" nil enable-local-variables ((byte-code "Àp!ˆŠÁyˆÂà `\"ˆ)ÄÅƃÈ!‚\"ÉÊ P\"!‡" [switch-to-buffer 0 set-window-start selected-window y-or-n-p format "Set local variables as specified at end of %s? " buffer-file-name file-name-nondirectory "buffer " buffer-name] 5)) enable-local-eval beg suffix prefixlen prefix continue " " 0 regexp-quote "$" selective-display re-search-forward "[\n ]" 1 looking-at error "Local variables entry is missing the prefix" "^:\n" "Missing colon in local variables entry" str read var val "end" "^:" "\n" "Local variables entry is terminated incorrectly" hack-one-local-variable] 6 "\ Parse and put into effect this buffer's local variables spec."]) (defconst ignored-local-variables (quote (enable-local-eval)) "\ Variables to be ignored in a file's local variable spec.") (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÆÂÃ#ˆÀÇÂÃ#ˆÀÈÂÃ#ˆÀÉÂÃ#ˆÀÊÂÃ#ˆÀËÂÃ#ˆÀÌÂÃ#ˆÀÍÂÃ#ˆÀÎÂÃ#ˆÀÏÂÃ#ˆÀÐÂÃ#ˆÀÑÂÃ#ˆÒÓÔ\"ˆÒÕÖ\"‡" [put debugger risky-local-variable t enable-local-eval eval file-name-handler-alist minor-mode-map-alist after-load-alist buffer-file-name buffer-auto-save-file-name buffer-file-truename exec-path load-path exec-directory process-environment outline-level rmail-output-file-alist defalias hack-one-local-variable-quotep #[(exp) ":…@Á=…A:‡" [exp quote] 2] hack-one-local-variable #[(var val) "Á=ƒÂÃ\f!—ÅP! ‡>ƒLJÈN„(ÉÊÃ!\"ƒ“Ë=ƒc\f:ƒc\f@Ì=ƒcÍ\fA@!ƒcÍÎ\f8!ƒcÏ\f8§„YÏ\f8КƒcÎ\f8A@Ñ>„{Ò ÓU„Õ=„{ƒÖ‹ƒË=ƒ‡ŠË\f!)‡×!ˆ\fL‡ØÙ!‡×!ˆ\fL‡" [var mode intern symbol-name val "-mode" ignored-local-variables nil risky-local-variable string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$" eval put hack-one-local-variable-quotep 2 3 (quote defun) (lisp-indent-hook) user-uid 0 enable-local-eval t ((byte-code "Àp!ˆŠÁyˆÂà `\"ˆ)ÄÅÆÇ!\"!‰ ‡" [switch-to-buffer 0 set-window-start selected-window y-or-n-p format "Process `eval' or hook local variables in file %s? " file-name-nondirectory buffer-file-name enable-local-eval] 5)) make-local-variable message "Ignoring `eval:' in file's local variables"] 4]] 4) (defalias 'set-visited-file-name #[(filename) "À\nƒ\nØ?…Ä\n!\nƒ Å\n!ƒ \nš„2\nƒ/È\n!ˆÉ ˆ\n\nƒjÊ!‰ ؃IÌÍ!ˆÏ=ƒU — Ð! Ò ˜„iÓ Ô\"ˆ)ÀÖ ˆ ƒy× !\n…ƒÙÚ!8)ÜÝ!ˆÜÞ!ˆÜß!ˆÜà!ˆ!ƒžÀ\"Üá!ˆ#!„±äà!ˆÔ %&%„˃Ï'ƒÏèÔ!ˆ‚Ïé %&ƒè%ƒèê&!ƒèë&%Ô#ˆ)…ñìÔ!‡" [nil truename filename "" expand-file-name file-truename-wrap find-file-visit-truename buffer-file-name lock-buffer unlock-buffer file-name-nondirectory new-name error "Empty file name" system-type vax-vms file-name-directory default-directory buffer-name rename-buffer t buffer-backed-up clear-visited-file-modtime abbreviate-file-name buffer-file-truename 10 file-attributes buffer-file-number kill-local-variable write-file-hooks local-write-file-hooks revert-buffer-function backup-inhibited vc-mode buffer-read-only backup-enable-predicate make-local-variable buffer-auto-save-file-name oauto auto-save-default auto-save-mode make-auto-save-file-name file-exists-p rename-file set-buffer-modified-p] 5 "\ Change name of file visited in current buffer to FILENAME. The next time the buffer is saved it will go in the newly specified file. nil or empty string as argument means make buffer not be visiting any file. Remember to delete the initial contents of the minibuffer if you wish to pass an empty string as the argument." "FSet visited file name: "]) (defalias 'write-file #[(filename) "ƒ Á˜„ Â!ƒ ƒÄ!Å !PÆ!ˆÇÈ!ˆÉ ‡" [filename "" file-directory-p buffer-file-name file-name-as-directory file-name-nondirectory set-visited-file-name set-buffer-modified-p t save-buffer] 3 "\ Write current buffer into file FILENAME. Makes buffer visit that file, and marks it not modified. If the buffer is already visiting a file, you can specify a directory name as FILENAME, to write a file of the same old name in that directory." (list (if buffer-file-name (read-file-name "Write file: " nil nil nil nil) (read-file-name "Write file: " (cdr (assq (quote default-directory) (buffer-local-variables))) nil nil (buffer-name))))]) (defalias 'backup-buffer #[nil "…I ?…I\n?…IÃ\f!…IÅ\f!ÆœÇHÈ>…I\fɉ‰‰\n \f Ï!Ð!‰ @\f A ÉÑÒ-‡" [make-backup-files backup-inhibited buffer-backed-up file-exists-p buffer-file-name file-attributes 8 0 (45 108) nil setmodes targets backupname backup-info real-file-name file-chase-links find-backup-file-name (byte-code "… Â=„ Ã=… †ÄÅÆ\"!ÃÈɈÂ\n ƒ8ƒ8ÃË̈A‰„, )‡" [targets delete-old-versions t nil y-or-n-p format "Delete excess backup versions of %s? " real-file-name (byte-code "„1 „1\nƒÃ\f!ÅV„1ƒ9Ç\f!É8†-Ê8Ë U?)ƒ9ÌÍΈ‚FÏ\fÑ#ˆÒ!̇" [file-precious-flag backup-by-copying backup-by-copying-when-linked file-nlinks real-file-name 1 backup-by-copying-when-mismatch file-attributes attr 9 2 user-uid nil (byte-code "À \nÉ$‡" [copy-file real-file-name backupname t] 5) ((file-error (byte-code "À !ƒ !„à !ˆÄ Ɖ$‡" [file-exists-p backupname file-writable-p delete-file copy-file real-file-name t] 5))) rename-file backupname t file-modes setmodes] 4) ((file-error (byte-code "ÀÁ!ÃÄ!ˆÅÆ!ˆÇÈɇ" [expand-file-name "~/%backup%~" backupname message "Cannot write backup file; backing up in ~/%%backup%%~" sleep-for 1 nil (byte-code "À \nÉ$‡" [copy-file real-file-name backupname t] 5) ((file-error (byte-code "À !ƒ !„à !ˆÄ Ɖ$‡" [file-exists-p backupname file-writable-p delete-file copy-file real-file-name t] 5)))] 3))) buffer-backed-up (byte-code "À @!‡" [delete-file targets] 2) ((file-error)) setmodes] 5) ((file-error))] 6 "\ Make a backup of the disk file visited by the current buffer, if appropriate. This is normally done before saving the buffer the first time. If the value is non-nil, it is the result of `file-modes' on the original file; this means that the caller, after saving the buffer, should change the modes of the new file to agree with the old modes."]) (defalias 'file-name-sans-versions #[(name &optional keep-backup-version) "À Â\"‰ƒ  \f#‚L ÅÇ=ƒ2ÈÉ \"†KÈÊ \"ƒ-Ë”†K G‚K\fƒ; G‚KÈÌ \"†KÈÍ \"†K GO)‡" [find-file-name-handler name file-name-sans-versions handler keep-backup-version 0 system-type vax-vms string-match ";[-+]?[0-9]*\\'" "\\.[^]>:]*\\(\\.[-+]?[0-9]*\\)\\'" 1 "\\.~[0-9]+~\\'" "~\\'"] 6 "\ Return FILENAME sans backup versions or strings. This is a separate procedure so your site-init or startup file can redefine it. If the optional argument KEEP-BACKUP-VERSION is non-nil, we do not remove backup version numbers, only true file version numbers."]) (defalias 'make-backup-file-name #[(file) "Á=ƒ !Å !ÆÇ\f\"…\fÈÉ•OÊQ)‡ ËP‡" [system-type ms-dos file-name-nondirectory file fn file-name-directory string-match "\\([^.]*\\)\\(\\..*\\)?" 0 1 ".bak" "~"] 4 "\ Create the non-numeric backup file name for FILE. This is a separate function so you can redefine it for customization."]) (defalias 'backup-file-name-p #[(file) "Á=ƒ ÂÃ\f\"‡ÂÅ\f\"‡" [system-type ms-dos string-match "\\.bak$" file "~$"] 3 "\ Return non-nil if FILE is a backup file name (numeric or not). This is a separate function so you can redefine it for customization. You may need to redefine `file-name-sans-versions' as well."]) (defalias 'backup-extract-version #[(fn) "ÀÁ\n #ƒÄ” UƒÅ\n ÆO!‡Ä‡" [string-match "[0-9]+~$" fn bv-length 0 string-to-int -1] 4 "\ Given the name of a numeric backup file, return the backup number. Uses the free variable `bv-length', whose value should be the index in the name where the version number begins."]) (defalias 'find-backup-file-name #[(fn) "Á=ƒ  !C‡Ä !ÅP‰GÈ È\nË\fÈ ËÈÏЈ „6 !C‚i ÅÑ\fT!ÒRËV…hÕ\\\\ËY…hÖ×\n›S›È¡ˆ)\"B.‡" [version-control never make-backup-file-name fn file-name-nondirectory ".~" base-versions bv-length nil possibilities versions 0 high-water-mark deserve-versions-p number-to-delete (byte-code "À  !\"ÅÆÇ\f\"È\" ÊËÌ # †! ÌV GZZÒZÀ‡" [file-name-all-completions base-versions file-name-directory fn possibilities sort mapcar backup-extract-version < versions apply max 0 high-water-mark version-control deserve-versions-p kept-old-versions kept-new-versions -1 number-to-delete] 4) ((file-error (byte-code "ÀÀ‡" [nil possibilities] 1))) int-to-string "~" kept-new-versions kept-old-versions -1 mapcar #[(n) "Á !ÄR‡" [fn ".~" int-to-string n "~"] 4] v] 6 "\ Find a file name for a backup file, and suggestions for deletions. Value is a list whose car is the name for the backup file and whose cdr is a list of old versions to consider deleting now."]) (defalias 'file-nlinks #[(filename) "À !A@‡" [file-attributes filename] 2 "\ Return number of names file FILENAME has."]) (defalias 'file-relative-name #[(filename &optional directory) "À !ÂÀ † \f!!ÅÇÈÉ !P \"„,Ê ËÌO!ÍP‚ Ë•ÎOP)‡" [expand-file-name filename file-name-as-directory directory default-directory "" ancestor string-match "^" regexp-quote file-name-directory 0 -1 "../" nil] 4 "\ Convert FILENAME to be relative to DIRECTORY (default: default-directory)."]) (defalias 'save-buffer #[(&optional args) "À Á ÂV ƒ\fÅ=?†\fÆ>‰ƒ&\fÉ>ƒ&Ê ƒ6ƒ6ÌÍÎ \"ˆÏ ˆ…H\fÐ>…Hʉ +‡" [buffer-modified-p buffer-size 50000 make-backup-files args 0 (16 64) large modp (16 64) nil buffer-backed-up message "Saving file %s..." buffer-file-name basic-save-buffer (4 64)] 5 "\ Save current buffer in visited file if modified. Versions described below. By default, makes the previous version into a backup file if previously requested or if this is the first save. With 1 or 3 \\[universal-argument]'s, marks this version to become a backup when the next save is done. With 2 or 3 \\[universal-argument]'s, unconditionally makes the previous version into a backup file. With argument of 0, never makes the previous version into a backup file. If a file's name is FOO, the names of its numbered backup versions are FOO.~i~ for various integers i. A non-numbered backup file is called FOO~. Numeric backups (rather than FOO~) will be made if value of `version-control' is not the atom `never' and either there are already numeric versions of the file being backed up, or `version-control' is non-nil. We don't want excessive versions piling up, so there are variables `kept-old-versions', which tells Emacs how many oldest versions to keep, and `kept-new-versions', which tells how many newest versions to keep. Defaults are 2 old versions and 2 new. `dired-kept-versions' controls dired's clean-directory (.) command. If `delete-old-versions' is nil, system will query user before trimming versions. Otherwise it does it silently." "p"]) (defalias 'delete-auto-save-file-if-necessary #[(&optional force) "… …\n˜?… „Ä …ÅÆÇˆÈ ‡" [buffer-auto-save-file-name delete-auto-save-files buffer-file-name force recent-auto-save-p nil (delete-file buffer-auto-save-file-name) ((file-error)) set-buffer-auto-saved] 3 "\ Delete auto-save file for current buffer if `delete-auto-save-files' is t. Normally delete only if the file was written by this Emacs since the last real save, but optional arg FORCE non-nil means delete anyway."]) (defalias 'basic-save-buffer #[nil "À ƒõÁ ‰Ç=ƒDƒDÉ!˜„DÂ\nÉ!Ë—!\fÍ\f!\nÎ\f!ˆ)Ï\n!ˆ)„RÐÑÒÓ!Â\"!ˆÔp!„oÕ!ƒoÖ×ØÙ!\"!„oÚÛ!ˆŒ~ˆdÜVƒ­dSfÝU„­ß=ƒdSfàU„­!ß=„¥!ƒ­â×ãÍ \"!ƒ­ŠdbˆÝcˆ)ä%&'#Â(‰)ƒÑ)@ ‰(„Ñ)A‰)„¾(„Ùê *Ýë!8,\fƒëÂíîˆ)ï !ˆðñ!+‡òó!‡" [buffer-modified-p recent-auto-save-p nil tempsetmodes setmodes recent-save system-type vax-vms buffer-file-name file-name-sans-versions buffer-new-name create-file-buffer buf buffer-name kill-buffer rename-buffer set-visited-file-name expand-file-name read-file-name "File to save in: " verify-visited-file-modtime file-exists-p yes-or-no-p format "%s has changed since visited or saved. Save anyway? " file-name-nondirectory error "Save not confirmed" 1 10 selective-display t 13 require-final-newline y-or-n-p "Buffer %s does not end in newline. Add one? " append write-contents-hooks local-write-file-hooks write-file-hooks done hooks basic-save-buffer-1 file-attributes buffer-file-number (set-file-modes buffer-file-name setmodes) ((error)) delete-auto-save-file-if-necessary run-hooks after-save-hook message "(No changes need to be saved)"] 6 "\ Save the current buffer in its visited file, if it has been modified." nil]) (defalias (quote basic-save-buffer-1) #[nil "À‰Ã\f!„CÅ\f!Ç!„ÈÉ\"ˆ‚BÊ\f!„.ÈË\"ˆ‚BÌÍÎÏ\f!\"!ƒ>ЂBÈÑ!ˆ)„KÓ Å\f!ƒ¾Ã!ƒ¾\fÀ‰‰‰‰ÛЃ›ÍÝ=ƒ…Þ‚†ß#Ê!T‚tàŽá ˆâedÀ%ˆÐ)ã\f!ä\fÐ#ˆ.‚×\nƒÏ „Ïã\f!å\fæ\"ˆâed\fÀÐ%ˆ) *‡" [nil setmodes tempsetmodes file-writable-p buffer-file-name file-name-directory dir file-directory-p error "%s is not a directory" file-exists-p "Directory %s write-protected" yes-or-no-p format "File %s is write-protected; try to save anyway? " file-name-nondirectory t "Attempt to save to a file which you aren't allowed to write" buffer-backed-up backup-buffer file-precious-flag succeed i nogood temp tempname realname 0 system-type vax-vms "%s$tmp$%d" "%s#tmp#%d" ((byte-code "„Á\n!ˆÁ‡" [succeed delete-file tempname] 2)) clear-visited-file-modtime write-region file-modes rename-file set-file-modes 511] 6]) (defalias 'save-some-buffers #[(&optional arg exiting) "À‹‡" [((byte-code "ÀÁÂà ÄÅÆÇEC%…- …-\n„%ËÌÍ\"!ƒ)ÏÐ!ˆÐ щÔV†?†?ÕÖ!*‡" [map-y-or-n-p #[(buffer) "À !…8 !„ …8 qˆ\f…8Å ÆV…8ƒ%ȇ !ƒ2ÉÊ !\"‡ÉËÌ !\"‡" [buffer-modified-p buffer buffer-file-name exiting buffer-offer-save buffer-size 0 arg t format "Save file %s? " "Save buffer %s? " buffer-name] 4] #[(buffer) "qˆÁ ‡" [buffer save-buffer] 1] buffer-list ("buffer" "buffers" "save") 18 #[(buf) "À !ˆÂÄ ˆÅ‡" [view-buffer buf (lambda (ignore) (exit-recursive-edit)) view-exit-action recursive-edit nil] 2] "display the current buffer" save-abbrevs abbrevs-changed arg y-or-n-p format "Save abbrevs in %s? " abbrev-file-name write-abbrev-file nil t abbrevs-done files-done 0 message "(No files need saving)"] 9))] 1 "\ Save some modified file-visiting buffers. Asks user about each one. Optional argument (the prefix) non-nil means save all with no questions. Optional second argument EXITING means ask about certain non-file buffers as well as about file buffers." "P"]) (defalias 'not-modified #[(&optional arg) "À ƒ ‚\nÃ!ˆÄ !‡" [message arg "Modification-flag set" "Modification-flag cleared" set-buffer-modified-p] 2 "\ Mark current buffer as unmodified, not needing to be saved. With prefix arg, mark buffer as modified, so \\[save-buffer] will save." "P"]) (defalias 'toggle-read-only #[(&optional arg) "„ ?‚Â!ÃVÄÅ !‡" [arg buffer-read-only prefix-numeric-value 0 set-buffer-modified-p buffer-modified-p] 2 "\ Change whether this buffer is visiting its file read-only. With arg, set read-only iff arg is positive." "P"]) (defalias 'insert-file #[(filename) "À !ƒÂÃÄÅ E\"ˆÆ !È`A@\\!)‡" [file-directory-p filename signal file-error "Opening input file" "file is a directory" insert-file-contents tem push-mark] 5 "\ Insert contents of file FILENAME into buffer after point. Set mark after the inserted text. This function is meant for the user to run interactively. Don't call it from programs! Use `insert-file-contents' instead. (Its calling sequence is different; see its documentation)." "*fInsert file: "]) (defalias 'append-to-file #[(start end filename) "À \n Ä$‡" [write-region start end filename t] 5 "\ Append the contents of the region to the end of file FILENAME. When called from a function, expects three arguments, START, END and FILENAME. START and END are buffer positions saying what text to write." "r\nFAppend to file: "]) (defalias 'file-newest-backup #[(filename) "À ! !Ä !Æ \"È ƒ> @PAÊ !ƒ ƒ8Ë  \"ƒ  ‚ -‡" [expand-file-name filename file-name-nondirectory file file-name-directory dir file-name-all-completions comp nil newest backup-file-name-p file-newer-than-file-p] 3 "\ Return most recent backup file for FILENAME or nil if no backups exist."]) (defalias 'rename-uniquely #[nil "ÀÁ !Á\n!Ä\n!ˆÅ !ˆÆÇ !*‡" [generate-new-buffer buffer-name new-buf name kill-buffer rename-buffer set-buffer-modified-p buffer-modified-p] 2 "\ Rename current buffer to a similar name not already taken. This function is useful for creating multiple shell process buffers or multiple mail buffers, etc." nil]) (defalias 'make-directory #[(dir &optional parents) "À Â\"‰ƒ  \f#‚a\f„Å !‚aÆÇ !!È \nË\n!„K\fÍ=ƒ7 ‚9\n B Î\n!Æ !\n‚% …`Å @!ˆ A‰ „PÈ*)‡" [find-file-name-handler dir make-directory handler parents make-directory-internal directory-file-name expand-file-name nil create-list dir1 file-exists-p system-type vax-vms file-name-directory] 5 "\ Create the directory DIR and any nonexistent parent dirs. Interactively, the default choice of directory to create is the current default directory for file names. That is useful when you have visited a file in a nonexistint directory. Noninteractively, the second (optional) argument PARENTS says whether to create parent directories if they don't exist." (list (read-file-name "Make directory: " default-directory default-directory nil nil) t)]) (put (quote revert-buffer-function) (quote permanent-local) t) (defvar revert-buffer-function nil "\ Function to use to revert this buffer, or nil to do the default. The function receives two arguments IGNORE-AUTO and NOCONFIRM, which are the arguments that `revert-buffer' received.") (put (quote revert-buffer-insert-file-contents-function) (quote permanent-local) t) (defvar revert-buffer-insert-file-contents-function nil "\ Function to use to insert contents when reverting this buffer. Gets two args, first the nominal file name to use, and second, t if reading the auto-save file.") (defalias 'revert-buffer #[(&optional ignore-auto noconfirm) "ƒ  \n\"‡` ?…\"Ä …\" …\"Æ !…\"ÇÈ!‰ ƒ, ‚.\n‰ „:ÌÍ!‚²\n„HÎÏÐ \"!…²ÑÒ!ˆ „ZÓp!„ZÔ×=„dÔÔ׃z  \"ˆ‚ Ú !„‡ÌÛ \"ˆÔ\n „’Ü ˆ)~ˆÝ  ?Ô‰×%ˆ* d^bˆÞԉ׉$ˆÑß!ˆ×+‡" [revert-buffer-function ignore-auto noconfirm opoint recent-auto-save-p buffer-auto-save-file-name file-readable-p y-or-n-p "Buffer has been auto-saved recently. Revert from auto-save file? " auto-save-p buffer-file-name file-name error "Buffer does not seem to be associated with any file" yes-or-no-p format "Revert buffer from file %s? " run-hooks before-revert-hook verify-visited-file-modtime nil buffer-backed-up buffer-undo-list t buffer-read-only revert-buffer-insert-file-contents-function file-exists-p "File %s no longer exists!" unlock-buffer insert-file-contents after-find-file after-revert-hook] 7 "\ Replace the buffer text with the text of the visited file on disk. This undoes all changes since the file was visited or saved. With a prefix argument, offer to revert from latest auto-save file, if that is more recent than the visited file. When called from lisp, The first argument is IGNORE-AUTO; only offer to revert from the auto-save file when this is nil. Note that the sense of this argument is the reverse of the prefix argument, for the sake of backward compatibility. IGNORE-AUTO is optional, defaulting to nil. Optional second argument NOCONFIRM means don't ask for confirmation at all. If the value of `revert-buffer-function' is non-nil, it is called to do the work. The default revert function runs the hook `before-revert-hook' at the beginning and `after-revert-hook' at the end." (list (not prefix-arg))]) (defalias 'recover-file #[(file) "À !Âà !!ƒÄÅ \"ˆ Ç )É \"„)ÄÊ\"‚MË‹ƒJÌÍ Î\"!ˆÏÑ ˆÒÏ\"ˆ)ÓωÎ#‚MÄÔ!)‡" [expand-file-name file auto-save-file-name-p file-name-nondirectory error "%s is an auto-save file" buffer-file-name make-auto-save-file-name file-name file-newer-than-file-p "Auto-save file %s not current" ((byte-code "Á=„%ÂÃ\f!ˆÅÆÇ\fÇÈ !ƒÊ‚Ë \f&‘ˆÍÎÏ\f\"!‡" [system-type vax-vms "*Directory*" buffer-disable-undo standard-output call-process "ls" nil file-symlink-p file "-lL" "-l" file-name yes-or-no-p format "Recover auto save file %s? "] 9)) switch-to-buffer find-file-noselect t nil buffer-read-only erase-buffer insert-file-contents after-find-file "Recover-file cancelled."] 4 "\ Visit file FILE, but get contents from its last auto-save file." (byte-code "Á‰‰ƒÅ\f!Æ\f!ÇÈ\nÁ‰ %+C‡" [buffer-file-name nil file-dir file-name prompt-file file-name-nondirectory file-name-directory read-file-name "Recover file: "] 7)]) (defalias 'kill-some-buffers #[nil "À ‰…= @Ã\n!‰Ř„4\fÆHÇU„4ÈÉÊ\fË\n!ƒ*Ì‚+Í#!ƒ4Î\n!ˆ* A‰„Ï)‡" [buffer-list list buffer buffer-name name "" 0 32 yes-or-no-p format "Buffer %s %s. Kill? " buffer-modified-p "HAS BEEN EDITED" "is unmodified" kill-buffer nil] 7 "\ For each buffer, ask whether to kill it." nil]) (defalias 'auto-save-mode #[(arg) "„ ƒ$\nÃW‚!Ä=„$<„$¨…8ÃV…8 ƒ6ƒ6„6 ‚8È \nÃWƒAÃtƒRÉÊ ƒOË‚PÌ\"ˆ ‡" [arg buffer-auto-save-file-name buffer-saved-size 0 t buffer-file-name auto-save-visited-file-name buffer-read-only make-auto-save-file-name message "Auto-save %s (in this buffer)" "on" "off"] 3 "\ Toggle auto-saving of contents of current buffer. With prefix argument ARG, turn auto-saving on if positive, else off." "P"]) (defalias 'rename-auto-save-file #[nil "  …+…+ ˜?…+ ˜?…+Ä !…+Å …+Æ Ç#)‡" [buffer-auto-save-file-name osave make-auto-save-file-name buffer-file-name file-exists-p recent-auto-save-p rename-file t] 4 "\ Adjust current buffer's auto save file name for current conditions. Also rename any existing auto save file, if it was made in this session."]) (defalias 'make-auto-save-file-name #[nil "ƒÁ!ÂÃ!ÂR‡Ä ÅÇÈ\f#ƒA\fʼn”O\fŔŕOɘƒ1Ê‚2Ë\fÅ•ÌOQÅ•T‚ÍÎÏ\fÐÑ!#!*‡" [buffer-file-name file-name-directory "#" file-name-nondirectory buffer-name 0 limit string-match "[/\\]" "/" "\\!" "\\\\" nil expand-file-name format "#%s#%s#" make-temp-name ""] 6 "\ Return file name to use for auto-saves of current buffer. Does not consider `auto-save-visited-file-name' as that variable is checked before calling this function. You can redefine this for customization. See also `auto-save-file-name-p'."]) (defalias 'auto-save-file-name-p #[(filename) "ÀÁ\n\"‡" [string-match "^#.*#$" filename] 3 "\ Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'. FILENAME should lack slashes. You can redefine this for customization."]) (defconst list-directory-brief-switches (byte-code "Á=ƒ‡Ç" [system-type vax-vms "/NODATE/NOSIZE/NOPROTECTION/NOOWNER/NOACL" "-CF"] 2) "\ *Switches for list-directory to pass to `ls' for brief listing,") (defconst list-directory-verbose-switches (byte-code "Á=ƒ‡Ç" [system-type vax-vms "/PROTECTION/SIZE/DATE/OWNER/WIDTH=(FILENAME=32,SIZE=5,OWNER=10)" "-l"] 2) "\ *Switches for list-directory to pass to `ls' for verbose listing,") (defalias 'list-directory #[(dirname &optional verbose) "ƒ ‚ \n\f„ Æ\f!ÇÈ !ˆ\nË=„-ÌÍ!ˆÌ\f!ˆÎ ˆŠÇqˆÏ\f!?Ñ\f ‰?$*‘)‡" [verbose list-directory-verbose-switches list-directory-brief-switches switches dirname default-directory expand-file-name "*Directory*" buffer-disable-undo standard-output system-type vax-vms princ "Directory " terpri file-directory-p wildcard insert-directory] 6 "\ Display a list of files in or matching DIRNAME, a la `ls'. DIRNAME is globbed by the shell if necessary. Prefix arg (second arg if noninteractive) means supply -l switch to `ls'. Actions controlled by variables `list-directory-brief-switches' and `list-directory-verbose-switches'." (byte-code " ƒ Â\fÄÅÅ$ )D‡" [current-prefix-arg pfx read-file-name "List directory (verbose): " "List directory (brief): " nil default-directory] 5)]) (defvar insert-directory-program (byte-code "Á=ƒ‡Ç" [system-type vax-vms "DIRECTORY" "ls"] 2) "\ Absolute or relative name of the `ls' program used by `insert-directory'.") (defalias 'insert-directory #[(file switches &optional wildcard full-directory-p) "ÀÁ\n!Ã\"‰ƒ\fÃ\n %‚éÉ=ƒ3ÊÁ\n!! Ì ÎÏÎ \n&)‚郘Ð\n!ƒDÊ\n!‚IÊÁ\n!!Ñ\n!Ò ÕÖ#ƒuÒ‰”O×Ò”ÎOQÒ•T‚SÌÎÏÎÙ Ú ;ƒˆ ‚ÛÜ Ý#Ý°&+‚éÞÌ ÎÏΉ <ƒ­ ‚Ó àš„ÓÕÝ \"ƒÍ Ò‰”OB Ò•ÎO‚³ Báƒãâ\n!ãP‚ä\nC\")&)‡" [find-file-name-handler expand-file-name file insert-directory handler switches wildcard full-directory-p system-type vax-vms file-name-directory default-directory call-process insert-directory-program nil t file-name-absolute-p file-name-nondirectory 0 beg pattern string-match "[ \n;<>&|()#$]" "\\" shell-file-name "-c" " -d " mapconcat identity " " apply list "" append file-name-as-directory "."] 13 "\ Insert directory listing for FILE, formatted according to SWITCHES. Leaves point after the inserted text. SWITCHES may be a string of options, or a list of strings. Optional third arg WILDCARD means treat FILE as shell wildcard. Optional fourth arg FULL-DIRECTORY-P means file is a directory and switches do not contain `d', so that a full listing is expected. This works by running a directory listing program whose name is in the variable `insert-directory-program'. If WILDCARD, it also runs the shell specified by `shell-file-name'. On VMS, if FILE ends with a semicolon, only the highest version will be inserted."]) (defvar kill-emacs-query-functions nil "\ Functions to call with no arguments to query about killing Emacs. If any of these functions returns nil, killing Emacs is cancelled.") (defalias 'save-buffers-kill-emacs #[(&optional arg) "À Â\"ˆÂÃÄÅ \">ƒÆÇ!…ŠÈÉ!ƒ^É Ê ‰\fƒQÍ\f@!Î>ƒHÏ\f@!Ï\f@\"ˆ)ƒH \fA‰\f„& ?†ZÆÑ!*…ŠÂ‰ƒ‚ƒ‚…w@ A‰„i*…ŠÕ ‡" [save-some-buffers arg t mapcar #[(buf) "À !…  !‡" [buffer-file-name buf buffer-modified-p] 2] buffer-list yes-or-no-p "Modified buffers exist; exit anyway? " fboundp process-list nil active processes process-status (run stop open) process-kill-without-query val "Active processes exist; kill them and exit anyway? " kill-emacs-query-functions yes functions kill-emacs] 5 "\ Offer to save each buffer, then kill this Emacs process. With prefix arg, silently save all file-visiting buffers, then kill." "P"]) (byte-code "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÀ ÈÉ#ˆÀ ÊË#ˆÀ ÌÍ#ˆÀ ÎÏ#ˆÀ ÐÑ#ˆÀÓÔ#ˆÀ ÕÖ#ˆÀ ×Ø#ˆÀÚÛ#ˆÀÜÝ#ˆÀÂÛ#ˆÀÞß#ˆÀàá#ˆÀ\"Þã#ˆÀ\"Úä#ˆÀ\"Âä#ˆÀ\"Üå#‡" [define-key ctl-x-map "" find-file "" toggle-read-only "" find-file-read-only "" find-alternate-file "" save-buffer "s" save-some-buffers "" write-file "i" insert-file esc-map "~" not-modified "" list-directory "" save-buffers-kill-emacs ctl-x-4-map "f" find-file-other-window "r" find-file-read-only-other-window "b" switch-to-buffer-other-window "" display-buffer ctl-x-5-map switch-to-buffer-other-frame find-file-other-frame find-file-read-only-other-frame] 4) àá#ˆÀ\"Þã#ˆÀ\"Úä#ˆÀ\"Âä#ˆÀ\"Üå#‡" [define-key ctl-x-map "" find-file "" toggle-read-only "" find-file-read-only "" find-alternate-file "" save-buffer "s" save-some-buffers "" write-file "i" insert-file esc-map "~" not-modified "" list-directory "" saveemacs-19_28/lisp/shell.el 644 23 204 106253 6027634703 10406 ;;; shell.el --- specialized comint.el for running the shell. ;; Copyright (C) 1988, 1993, 1994 Free Software Foundation, Inc. ;; Author: Olin Shivers ;; Maintainer: Simon Marshall ;; Keywords: processes ;; This file is part of GNU Emacs. ;; GNU Emacs 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 2, or (at your option) ;; any later version. ;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;;; Please send me bug reports, bug fixes, and extensions, so that I can ;;; merge them into the master source. ;;; - Olin Shivers (shivers@cs.cmu.edu) ;;; - Simon Marshall (s.marshall@dcs.hull.ac.uk) ;;; This file defines a a shell-in-a-buffer package (shell mode) built ;;; on top of comint mode. This is actually cmushell with things ;;; renamed to replace its counterpart in Emacs 18. cmushell is more ;;; featureful, robust, and uniform than the Emacs 18 version. ;;; Since this mode is built on top of the general command-interpreter-in- ;;; a-buffer mode (comint mode), it shares a common base functionality, ;;; and a common set of bindings, with all modes derived from comint mode. ;;; This makes these modes easier to use. ;;; For documentation on the functionality provided by comint mode, and ;;; the hooks available for customising it, see the file comint.el. ;;; For further information on shell mode, see the comments below. ;;; Needs fixin: ;;; When sending text from a source file to a subprocess, the process-mark can ;;; move off the window, so you can lose sight of the process interactions. ;;; Maybe I should ensure the process mark is in the window when I send ;;; text to the process? Switch selectable? ;; YOUR .EMACS FILE ;;============================================================================= ;; Some suggestions for your .emacs file. ;; ;; ;; Define C-c t to run my favorite command in shell mode: ;; (setq shell-mode-hook ;; '((lambda () ;; (define-key shell-mode-map "\C-ct" 'favorite-cmd)))) ;;; Brief Command Documentation: ;;;============================================================================ ;;; Comint Mode Commands: (common to shell and all comint-derived modes) ;;; ;;; m-p comint-previous-input Cycle backwards in input history ;;; m-n comint-next-input Cycle forwards ;;; m-r comint-previous-matching-input Previous input matching a regexp ;;; m-R comint-previous-matching-input-from-input -"- matching input ;;; m-s comint-next-matching-input Next input that matches ;;; m-S comint-next-matching-input-from-input -"- matching input ;;; m-c-l comint-show-output Show last batch of process output ;;; return comint-send-input ;;; c-d comint-delchar-or-maybe-eof Delete char unless at end of buff. ;;; c-c c-a comint-bol Beginning of line; skip prompt ;;; c-c c-u comint-kill-input ^u ;;; c-c c-w backward-kill-word ^w ;;; c-c c-c comint-interrupt-subjob ^c ;;; c-c c-z comint-stop-subjob ^z ;;; c-c c-\ comint-quit-subjob ^\ ;;; c-c c-o comint-kill-output Delete last batch of process output ;;; c-c c-r comint-show-output Show last batch of process output ;;; c-c c-h comint-dynamic-list-input-ring List input history ;;; send-invisible Read line w/o echo & send to proc ;;; comint-continue-subjob Useful if you accidentally suspend ;;; top-level job ;;; comint-mode-hook is the comint mode hook. ;;; Shell Mode Commands: ;;; shell Fires up the shell process ;;; tab comint-dynamic-complete Complete filename/command/history ;;; m-? comint-dynamic-list-filename-completions List completions in help buffer ;;; m-c-f shell-forward-command Forward a shell command ;;; m-c-b shell-backward-command Backward a shell command ;;; dirs Resync the buffer's dir stack ;;; dirtrack-toggle Turn dir tracking on/off ;;; shell-strip-ctrl-m Remove trailing ^Ms from output ;;; ;;; The shell mode hook is shell-mode-hook ;;; comint-prompt-regexp is initialised to shell-prompt-pattern, for backwards ;;; compatibility. ;;; Read the rest of this file for more information. ;;; SHELL.EL COMPATIBILITY ;;; Notes from when this was called cmushell, and was not the standard emacs ;;; shell package. ;;;============================================================================ ;;; In brief: this package should have no trouble coexisting with shell.el. ;;; ;;; Most customising variables -- e.g., explicit-shell-file-name -- are the ;;; same, so the users shouldn't have much trouble. Hooks have different ;;; names, however, so you can customise shell mode differently from cmushell ;;; mode. You basically just have to remember to type M-x cmushell instead of ;;; M-x shell. ;;; ;;; It would be nice if this file was completely plug-compatible with the old ;;; shell package -- if you could just name this file shell.el, and have it ;;; transparently replace the old one. But you can't. Several other packages ;;; (tex-mode, background, dbx, gdb, kermit, monkey, prolog, telnet) are also ;;; clients of shell mode. These packages assume detailed knowledge of shell ;;; mode internals in ways that are incompatible with cmushell mode (mostly ;;; because of cmushell mode's greater functionality). So, unless we are ;;; willing to port all of these packages, we can't have this file be a ;;; complete replacement for shell.el -- that is, we can't name this file ;;; shell.el, and its main entry point (shell), because dbx.el will break ;;; when it loads it in and tries to use it. ;;; ;;; There are two ways to fix this. One: rewrite these other modes to use the ;;; new package. This is a win, but can't be assumed. The other, backwards ;;; compatible route, is to make this package non-conflict with shell.el, so ;;; both files can be loaded in at the same time. And *that* is why some ;;; functions and variables have different names: (cmushell), ;;; cmushell-mode-map, that sort of thing. All the names have been carefully ;;; chosen so that shell.el and cmushell.el won't tromp on each other. ;;; Customization and Buffer Variables ;;; =========================================================================== ;;; ;;; Code: (require 'comint) ;;;###autoload (defvar shell-prompt-pattern "^[^#$%>\n]*[#$%>] *" "Regexp to match prompts in the inferior shell. Defaults to \"^[^#$%>\\n]*[#$%>] *\", which works pretty well. This variable is used to initialise `comint-prompt-regexp' in the shell buffer. The pattern should probably not match more than one line. If it does, shell-mode may become confused trying to distinguish prompt from input on lines which don't start with a prompt. This is a fine thing to set in your `.emacs' file.") (defvar shell-completion-fignore nil "*List of suffixes to be disregarded during file/command completion. This variable is used to initialize `comint-completion-fignore' in the shell buffer. The default is nil, for compatibility with most shells. Some people like (\"~\" \"#\" \"%\"). This is a fine thing to set in your `.emacs' file.") (defvar shell-delimiter-argument-list '(?\| ?& ?< ?> ?\( ?\) ?\;) "List of characters to recognise as separate arguments. This variable is used to initialize `comint-delimiter-argument-list' in the shell buffer. The default is (?\\| ?& ?< ?> ?\\( ?\\) ?\\;). This is a fine thing to set in your `.emacs' file.") (defvar shell-dynamic-complete-functions '(comint-replace-by-expanded-history shell-dynamic-complete-environment-variable shell-dynamic-complete-command shell-replace-by-expanded-directory comint-dynamic-complete-filename) "List of functions called to perform completion. This variable is used to initialise `comint-dynamic-complete-functions' in the shell buffer. This is a fine thing to set in your `.emacs' file.") (defvar shell-command-regexp "[^;&|\n]+" "*Regexp to match a single command within a pipeline. This is used for directory tracking and does not do a perfect job.") (defvar shell-completion-execonly t "*If non-nil, use executable files only for completion candidates. This mirrors the optional behavior of tcsh. Detecting executability of files may slow command completion considerably.") (defvar shell-popd-regexp "popd" "*Regexp to match subshell commands equivalent to popd.") (defvar shell-pushd-regexp "pushd" "*Regexp to match subshell commands equivalent to pushd.") (defvar shell-pushd-tohome nil "*If non-nil, make pushd with no arg behave as \"pushd ~\" (like cd). This mirrors the optional behavior of tcsh.") (defvar shell-pushd-dextract nil "*If non-nil, make \"pushd +n\" pop the nth dir to the stack top. This mirrors the optional behavior of tcsh.") (defvar shell-pushd-dunique nil "*If non-nil, make pushd only add unique directories to the stack. This mirrors the optional behavior of tcsh.") (defvar shell-cd-regexp ;(if (eq system-type 'vax-vms) ;"\\(cd\\|set *de\\(f\\|fa\\|fau\\|faul\\|fault\\)\\)" "cd";) "*Regexp to match subshell commands equivalent to cd.") (defvar explicit-shell-file-name nil "*If non-nil, is file name to use for explicitly requested inferior shell.") (defvar explicit-csh-args (if (eq system-type 'hpux) ;; -T persuades HP's csh not to think it is smarter ;; than us about what terminal modes to use. '("-i" "-T") '("-i")) "*Args passed to inferior shell by M-x shell, if the shell is csh. Value is a list of strings, which may be nil.") (defvar shell-input-autoexpand 'history "*If non-nil, expand input command history references on completion. This mirrors the optional behavior of tcsh (its autoexpand and histlit). If the value is `input', then the expansion is seen on input. If the value is `history', then the expansion is only when inserting into the buffer's input ring. See also `comint-magic-space' and `comint-dynamic-complete'. This variable supplies a default for `comint-input-autoexpand', for Shell mode only.") (defvar shell-dirstack nil "List of directories saved by pushd in this buffer's shell. Thus, this does not include the shell's current directory.") (defvar shell-dirtrackp t "Non-nil in a shell buffer means directory tracking is enabled.") (defvar shell-last-dir nil "Keep track of last directory for ksh `cd -' command.") (defvar shell-dirstack-query nil "Command used by `shell-resync-dir' to query the shell.") (defvar shell-mode-map nil) (cond ((not shell-mode-map) (setq shell-mode-map (copy-keymap comint-mode-map)) (define-key shell-mode-map "\C-c\C-f" 'shell-forward-command) (define-key shell-mode-map "\C-c\C-b" 'shell-backward-command) (define-key shell-mode-map "\t" 'comint-dynamic-complete) (define-key shell-mode-map "\M-?" 'comint-dynamic-list-filename-completions) (define-key-after (lookup-key shell-mode-map [menu-bar completion]) [complete-env-variable] '("Complete Env. Variable Name" . shell-dynamic-complete-environment-variable) 'complete-file) (define-key-after (lookup-key shell-mode-map [menu-bar completion]) [expand-directory] '("Expand Directory Reference" . shell-replace-by-expanded-directory) 'complete-expand))) (defvar shell-mode-hook '() "*Hook for customising Shell mode.") ;;; Basic Procedures ;;; =========================================================================== ;;; (defun shell-mode () "Major mode for interacting with an inferior shell. Return after the end of the process' output sends the text from the end of process to the end of the current line. Return before end of process output copies the current line (except for the prompt) to the end of the buffer and sends it. M-x send-invisible reads a line of text without echoing it, and sends it to the shell. This is useful for entering passwords. Or, add the function `comint-watch-for-password-prompt' to `comint-output-filter-functions'. If you accidentally suspend your process, use \\[comint-continue-subjob] to continue it. cd, pushd and popd commands given to the shell are watched by Emacs to keep this buffer's default directory the same as the shell's working directory. M-x dirs queries the shell and resyncs Emacs' idea of what the current directory stack is. M-x dirtrack-toggle turns directory tracking on and off. \\{shell-mode-map} Customization: Entry to this mode runs the hooks on `comint-mode-hook' and `shell-mode-hook' (in that order). Before each input, the hooks on `comint-input-filter-functions' are run. After each shell output, the hooks on `comint-output-filter-functions' are run. Variables `shell-cd-regexp', `shell-pushd-regexp' and `shell-popd-regexp' are used to match their respective commands, while `shell-pushd-tohome', `shell-pushd-dextract' and `shell-pushd-dunique' control the behavior of the relevant command. Variables `comint-completion-autolist', `comint-completion-addsuffix', `comint-completion-recexact' and `comint-completion-fignore' control the behavior of file name, command name and variable name completion. Variable `shell-completion-execonly' controls the behavior of command name completion. Variable `shell-completion-fignore' is used to initialise the value of `comint-completion-fignore'. Variables `comint-input-ring-file-name' and `comint-input-autoexpand' control the initialisation of the input ring history, and history expansion. Variables `comint-output-filter-functions', a hook, and `comint-scroll-to-bottom-on-input' and `comint-scroll-to-bottom-on-output' control whether input and output cause the window to scroll to the end of the buffer." (interactive) (comint-mode) (setq major-mode 'shell-mode) (setq mode-name "Shell") (use-local-map shell-mode-map) (setq comint-prompt-regexp shell-prompt-pattern) (setq comint-completion-fignore shell-completion-fignore) (setq comint-delimiter-argument-list shell-delimiter-argument-list) (setq comint-dynamic-complete-functions shell-dynamic-complete-functions) (make-local-variable 'paragraph-start) (setq paragraph-start comint-prompt-regexp) (make-local-variable 'shell-dirstack) (setq shell-dirstack nil) (setq shell-last-dir nil) (make-local-variable 'shell-dirtrackp) (setq shell-dirtrackp t) (add-hook 'comint-input-filter-functions 'shell-directory-tracker) (setq comint-input-autoexpand shell-input-autoexpand) ;; shell-dependent assignments. (let ((shell (file-name-nondirectory (car (process-command (get-buffer-process (current-buffer))))))) (setq comint-input-ring-file-name (or (getenv "HISTFILE") (cond ((string-equal shell "bash") "~/.bash_history") ((string-equal shell "ksh") "~/.sh_history") (t "~/.history")))) (if (equal comint-input-ring-file-name "/dev/null") (setq comint-input-ring-file-name nil)) (setq shell-dirstack-query (if (string-match "^k?sh$" shell) "pwd" "dirs"))) (run-hooks 'shell-mode-hook) (comint-read-input-ring t)) ;;;###autoload (defun shell () "Run an inferior shell, with I/O through buffer *shell*. If buffer exists but shell process is not running, make new shell. If buffer exists and shell process is running, just switch to buffer `*shell*'. Program used comes from variable `explicit-shell-file-name', or (if that is nil) from the ESHELL environment variable, or else from SHELL if there is no ESHELL. If a file `~/.emacs_SHELLNAME' exists, it is given as initial input (Note that this may lose due to a timing error if the shell discards input when it starts up.) The buffer is put in Shell mode, giving commands for sending input and controlling the subjobs of the shell. See `shell-mode'. See also the variable `shell-prompt-pattern'. The shell file name (sans directories) is used to make a symbol name such as `explicit-csh-args'. If that symbol is a variable, its value is used as a list of arguments when invoking the shell. Otherwise, one argument `-i' is passed to the shell. \(Type \\[describe-mode] in the shell buffer for a list of commands.)" (interactive) (if (not (comint-check-proc "*shell*")) (let* ((prog (or explicit-shell-file-name (getenv "ESHELL") (getenv "SHELL") (if (eq system-type 'vax-vms) "*dcl*" "/bin/sh"))) (name (file-name-nondirectory prog)) (startfile (concat "~/.emacs_" (make-legal-file-name name))) (xargs-name (intern-soft (concat "explicit-" name "-args")))) (set-buffer (apply 'make-comint "shell" prog (if (file-exists-p startfile) startfile) (if (and xargs-name (boundp xargs-name)) (symbol-value xargs-name) (if (eq system-type 'vax-vms) '("") '("-i"))))) (shell-mode))) (switch-to-buffer "*shell*")) ;;; Directory tracking ;;; =========================================================================== ;;; This code provides the shell mode input sentinel ;;; SHELL-DIRECTORY-TRACKER ;;; that tracks cd, pushd, and popd commands issued to the shell, and ;;; changes the current directory of the shell buffer accordingly. ;;; ;;; This is basically a fragile hack, although it's more accurate than ;;; the version in Emacs 18's shell.el. It has the following failings: ;;; 1. It doesn't know about the cdpath shell variable. ;;; 2. It cannot infallibly deal with command sequences, though it does well ;;; with these and with ignoring commands forked in another shell with ()s. ;;; 3. More generally, any complex command is going to throw it. Otherwise, ;;; you'd have to build an entire shell interpreter in emacs lisp. Failing ;;; that, there's no way to catch shell commands where cd's are buried ;;; inside conditional expressions, aliases, and so forth. ;;; ;;; The whole approach is a crock. Shell aliases mess it up. File sourcing ;;; messes it up. You run other processes under the shell; these each have ;;; separate working directories, and some have commands for manipulating ;;; their w.d.'s (e.g., the lcd command in ftp). Some of these programs have ;;; commands that do *not* affect the current w.d. at all, but look like they ;;; do (e.g., the cd command in ftp). In shells that allow you job ;;; control, you can switch between jobs, all having different w.d.'s. So ;;; simply saying %3 can shift your w.d.. ;;; ;;; The solution is to relax, not stress out about it, and settle for ;;; a hack that works pretty well in typical circumstances. Remember ;;; that a half-assed solution is more in keeping with the spirit of Unix, ;;; anyway. Blech. ;;; ;;; One good hack not implemented here for users of programmable shells ;;; is to program up the shell w.d. manipulation commands to output ;;; a coded command sequence to the tty. Something like ;;; ESC | | ;;; where is the new current working directory. Then trash the ;;; directory tracking machinery currently used in this package, and ;;; replace it with a process filter that watches for and strips out ;;; these messages. (defun shell-directory-tracker (str) "Tracks cd, pushd and popd commands issued to the shell. This function is called on each input passed to the shell. It watches for cd, pushd and popd commands and sets the buffer's default directory to track these commands. You may toggle this tracking on and off with M-x dirtrack-toggle. If emacs gets confused, you can resync with the shell with M-x dirs. See variables `shell-cd-regexp', `shell-pushd-regexp', and `shell-popd-regexp', while `shell-pushd-tohome', `shell-pushd-dextract' and `shell-pushd-dunique' control the behavior of the relevant command. Environment variables are expanded, see function `substitute-in-file-name'." (if shell-dirtrackp ;; We fail gracefully if we think the command will fail in the shell. (condition-case chdir-failure (let ((start (progn (string-match "^\\(\\s\\|[; ]\\)*" ; skip whitespace str) (match-end 0))) end cmd arg1 arg2) (while (string-match shell-command-regexp str start) (setq end (match-end 0) cmd (comint-arguments (substring str start end) 0 0) arg1 (comint-arguments (substring str start end) 1 1)) (cond ((eq (string-match shell-popd-regexp cmd) 0) (shell-process-popd (substitute-in-file-name arg1))) ((eq (string-match shell-pushd-regexp cmd) 0) (shell-process-pushd (substitute-in-file-name arg1))) ((eq (string-match shell-cd-regexp cmd) 0) (shell-process-cd (substitute-in-file-name arg1))) ((and (memq system-type '(vax-vms axp-vms)) (string-match "^set$" cmd) (= (string-match "^def\\(a\\(u\\(lt?\\)?\\)?\\)?$" arg1) 0)) (setq arg2 (comint-arguments (substring str start end) 2 2)) (shell-process-cd (substitute-in-file-name arg2)))) (setq start (progn (string-match "\\(\\s\\|[; ]\\)*" ; skip again str end) (match-end 0))) ;;(setq start (progn (string-match "[;\\s ]*" str end) ; skip again ;; (match-end 0))) )) (error "Couldn't cd")))) ;;; popd [+n] (defun shell-process-popd (arg) (let ((num (or (shell-extract-num arg) 0))) (cond ((and num (= num 0) shell-dirstack) (cd (car shell-dirstack)) (setq shell-dirstack (cdr shell-dirstack)) (shell-dirstack-message)) ((and num (> num 0) (<= num (length shell-dirstack))) (let* ((ds (cons nil shell-dirstack)) (cell (nthcdr (1- num) ds))) (rplacd cell (cdr (cdr cell))) (setq shell-dirstack (cdr ds)) (shell-dirstack-message))) (t (error "Couldn't popd"))))) ;; Return DIR prefixed with comint-file-name-prefix as appropriate. (defun shell-prefixed-directory-name (dir) (if (memq system-type '(vax-vms axp-vms)) ;; It may be a logical the user's moving to, and in that case, ;; it's probably not concealed... (let ((old-dir dir)) (while (and dir (string-match "^\\([A-Za-z$_][A-Za-z$_]*\\):?$" dir) (setq old-dir dir dir (vms-system-info "LOGICAL" (upcase (substring dir (match-beginning 1) (match-end 1))))))) (or dir old-dir)) (if (= (length comint-file-name-prefix) 0) dir (if (file-name-absolute-p dir) ;; The name is absolute, so prepend the prefix. (concat comint-file-name-prefix dir) ;; For a relative name we assume default-directory already has the prefix. (expand-file-name dir))))) ;;; cd [dir] (defun shell-process-cd (arg) (let ((new-dir (cond ((zerop (length arg)) (concat comint-file-name-prefix "~")) ((string-equal "-" arg) shell-last-dir) (t (shell-prefixed-directory-name arg))))) (setq shell-last-dir default-directory) (cd new-dir) (shell-dirstack-message))) ;;; pushd [+n | dir] (defun shell-process-pushd (arg) (let ((num (shell-extract-num arg))) (cond ((zerop (length arg)) ;; no arg -- swap pwd and car of stack unless shell-pushd-tohome (cond (shell-pushd-tohome (shell-process-pushd (concat comint-file-name-prefix "~"))) (shell-dirstack (let ((old default-directory)) (cd (car shell-dirstack)) (setq shell-dirstack (cons old (cdr shell-dirstack))) (shell-dirstack-message))) (t (message "Directory stack empty.")))) ((numberp num) ;; pushd +n (cond ((> num (length shell-dirstack)) (message "Directory stack not that deep.")) ((= num 0) (error (message "Couldn't cd."))) (shell-pushd-dextract (let ((dir (nth (1- num) shell-dirstack))) (shell-process-popd arg) (shell-process-pushd default-directory) (cd dir) (shell-dirstack-message))) (t (let* ((ds (cons default-directory shell-dirstack)) (dslen (length ds)) (front (nthcdr num ds)) (back (reverse (nthcdr (- dslen num) (reverse ds)))) (new-ds (append front back))) (cd (car new-ds)) (setq shell-dirstack (cdr new-ds)) (shell-dirstack-message))))) (t ;; pushd (let ((old-wd default-directory)) (cd (shell-prefixed-directory-name arg)) (if (or (null shell-pushd-dunique) (not (member old-wd shell-dirstack))) (setq shell-dirstack (cons old-wd shell-dirstack))) (shell-dirstack-message)))))) ;; If STR is of the form +n, for n>0, return n. Otherwise, nil. (defun shell-extract-num (str) (and (string-match "^\\+[1-9][0-9]*$" str) (string-to-int str))) (defun shell-dirtrack-toggle () "Turn directory tracking on and off in a shell buffer." (interactive) (setq shell-dirtrackp (not shell-dirtrackp)) (message "Directory tracking %s" (if shell-dirtrackp "ON" "OFF"))) ;;; For your typing convenience: (defalias 'dirtrack-toggle 'shell-dirtrack-toggle) (defun shell-resync-dirs () "Resync the buffer's idea of the current directory stack. This command queries the shell with the command bound to `shell-dirstack-query' (default \"dirs\"), reads the next line output and parses it to form the new directory stack. DON'T issue this command unless the buffer is at a shell prompt. Also, note that if some other subprocess decides to do output immediately after the query, its output will be taken as the new directory stack -- you lose. If this happens, just do the command again." (interactive) (let* ((proc (get-buffer-process (current-buffer))) (pmark (process-mark proc))) (goto-char pmark) (insert shell-dirstack-query) (insert "\n") (sit-for 0) ; force redisplay (comint-send-string proc shell-dirstack-query) (comint-send-string proc "\n") (set-marker pmark (point)) (let ((pt (point))) ; wait for 1 line ;; This extra newline prevents the user's pending input from spoofing us. (insert "\n") (backward-char 1) (while (not (looking-at ".+\n")) (accept-process-output proc) (goto-char pt))) (goto-char pmark) (delete-char 1) ; remove the extra newline ;; That's the dirlist. grab it & parse it. (let* ((dl (buffer-substring (match-beginning 0) (1- (match-end 0)))) (dl-len (length dl)) (ds '()) ; new dir stack (i 0)) (while (< i dl-len) ;; regexp = optional whitespace, (non-whitespace), optional whitespace (string-match "\\s *\\(\\S +\\)\\s *" dl i) ; pick off next dir (setq ds (cons (concat comint-file-name-prefix (substring dl (match-beginning 1) (match-end 1))) ds)) (setq i (match-end 0))) (let ((ds (nreverse ds))) (condition-case nil (progn (cd (car ds)) (setq shell-dirstack (cdr ds)) (shell-dirstack-message)) (error (message "Couldn't cd."))))))) ;;; For your typing convenience: (defalias 'dirs 'shell-resync-dirs) ;;; Show the current dirstack on the message line. ;;; Pretty up dirs a bit by changing "/usr/jqr/foo" to "~/foo". ;;; (This isn't necessary if the dirlisting is generated with a simple "dirs".) ;;; All the commands that mung the buffer's dirstack finish by calling ;;; this guy. (defun shell-dirstack-message () (let* ((msg "") (ds (cons default-directory shell-dirstack)) (home (expand-file-name (concat (if (memq system-type '(vax-vms axp-vms)) "" comint-file-name-prefix) "~/"))) (homelen (length home))) (while ds (let ((dir (car ds))) (and (not (memq system-type '(vax-vms axp-vms))) (>= (length dir) homelen) (string= home (substring dir 0 homelen)) (setq dir (concat "~/" (substring dir homelen)))) ;; Strip off comint-file-name-prefix if present. (and (not (memq system-type '(vax-vms axp-vms))) comint-file-name-prefix (>= (length dir) (length comint-file-name-prefix)) (string= comint-file-name-prefix (substring dir 0 (length comint-file-name-prefix))) (setq dir (substring dir (length comint-file-name-prefix))) (setcar ds dir)) (setq msg (concat msg (if (eq system-type 'vax-vms) dir (directory-file-name dir)) " ")) (setq ds (cdr ds)))) (message msg))) (defun shell-forward-command (&optional arg) "Move forward across ARG shell command(s). Does not cross lines. See `shell-command-regexp'." (interactive "p") (let ((limit (save-excursion (end-of-line nil) (point)))) (if (re-search-forward (concat shell-command-regexp "\\([;&|][\t ]*\\)+") limit 'move arg) (skip-syntax-backward " ")))) (defun shell-backward-command (&optional arg) "Move backward across ARG shell command(s). Does not cross lines. See `shell-command-regexp'." (interactive "p") (let ((limit (save-excursion (comint-bol nil) (point)))) (if (> limit (point)) (save-excursion (beginning-of-line) (setq limit (point)))) (skip-syntax-backward " " limit) (if (re-search-backward (format "[;&|]+[\t ]*\\(%s\\)" shell-command-regexp) limit 'move arg) (progn (goto-char (match-beginning 1)) (skip-chars-forward ";&|"))))) (defun shell-dynamic-complete-command () "Dynamically complete the command at point. This function is similar to `comint-dynamic-complete-filename', except that it searches `exec-path' (minus the trailing emacs library path) for completion candidates. Note that this may not be the same as the shell's idea of the path. Completion is dependent on the value of `shell-completion-execonly', plus those that effect file completion. See `shell-dynamic-complete-as-command'. Returns t if successful." (interactive) (let ((filename (comint-match-partial-filename))) (if (and filename (save-match-data (not (string-match "[~/]" filename))) (eq (match-beginning 0) (save-excursion (shell-backward-command 1) (point)))) (prog2 (message "Completing command name...") (shell-dynamic-complete-as-command))))) (defun shell-dynamic-complete-as-command () "Dynamically complete at point as a command. See `shell-dynamic-complete-filename'. Returns t if successful." (let* ((filename (or (comint-match-partial-filename) "")) (pathnondir (file-name-nondirectory filename)) (paths (cdr (reverse exec-path))) (cwd (file-name-as-directory (expand-file-name default-directory))) (ignored-extensions (and comint-completion-fignore (mapconcat (function (lambda (x) (concat (regexp-quote x) "$"))) comint-completion-fignore "\\|"))) (path "") (comps-in-path ()) (file "") (filepath "") (completions ())) ;; Go thru each path in the search path, finding completions. (while paths (setq path (file-name-as-directory (comint-directory (or (car paths) "."))) comps-in-path (and (file-accessible-directory-p path) (file-name-all-completions pathnondir path))) ;; Go thru each completion found, to see whether it should be used. (while comps-in-path (setq file (car comps-in-path) filepath (concat path file)) (if (and (not (member file completions)) (not (and ignored-extensions (string-match ignored-extensions file))) (or (string-equal path cwd) (not (file-directory-p filepath))) (or (null shell-completion-execonly) (file-executable-p filepath))) (setq completions (cons file completions))) (setq comps-in-path (cdr comps-in-path))) (setq paths (cdr paths))) ;; OK, we've got a list of completions. (let ((success (let ((comint-completion-addsuffix nil)) (comint-dynamic-simple-complete pathnondir completions)))) (if (and (memq success '(sole shortest)) comint-completion-addsuffix (not (file-directory-p (comint-match-partial-filename)))) (insert " ")) success))) (defun shell-match-partial-variable () "Return the variable at point, or nil if non is found." (save-excursion (let ((limit (point))) (if (re-search-backward "[^A-Za-z0-9_{}]" nil 'move) (or (looking-at "\\$") (forward-char 1))) ;; Anchor the search forwards. (if (or (eolp) (looking-at "[^A-Za-z0-9_{}$]")) nil (re-search-forward "\\$?{?[A-Za-z0-9_]*}?" limit) (buffer-substring (match-beginning 0) (match-end 0)))))) (defun shell-dynamic-complete-environment-variable () "Dynamically complete the environment variable at point. Completes if after a variable, i.e., if it starts with a \"$\". See `shell-dynamic-complete-as-environment-variable'. This function is similar to `comint-dynamic-complete-filename', except that it searches `process-environment' for completion candidates. Note that this may not be the same as the interpreter's idea of variable names. The main problem with this type of completion is that `process-environment' is the environment which Emacs started with. Emacs does not track changes to the environment made by the interpreter. Perhaps it would be more accurate if this function was called `shell-dynamic-complete-process-environment-variable'. Returns non-nil if successful." (interactive) (let ((variable (shell-match-partial-variable))) (if (and variable (string-match "^\\$" variable)) (prog2 (message "Completing variable name...") (shell-dynamic-complete-as-environment-variable))))) (defun shell-dynamic-complete-as-environment-variable () "Dynamically complete at point as an environment variable. Used by `shell-dynamic-complete-environment-variable'. Uses `comint-dynamic-simple-complete'." (let* ((var (or (shell-match-partial-variable) "")) (variable (substring var (or (string-match "[^$({]\\|$" var) 0))) (variables (mapcar (function (lambda (x) (substring x 0 (string-match "=" x)))) process-environment)) (addsuffix comint-completion-addsuffix) (comint-completion-addsuffix nil) (success (comint-dynamic-simple-complete variable variables))) (if (memq success '(sole shortest)) (let* ((var (shell-match-partial-variable)) (variable (substring var (string-match "[^$({]" var))) (protection (cond ((string-match "{" var) "}") ((string-match "(" var) ")") (t ""))) (suffix (cond ((null addsuffix) "") ((file-directory-p (comint-directory (getenv variable))) "/") (t " ")))) (insert protection suffix))) success)) (defun shell-replace-by-expanded-directory () "Expand directory stack reference before point. Directory stack references are of the form \"=digit\" or \"=-\". See `default-directory' and `shell-dirstack'. Returns t if successful." (interactive) (if (comint-match-partial-filename) (save-excursion (goto-char (match-beginning 0)) (let ((stack (cons default-directory shell-dirstack)) (index (cond ((looking-at "=-/?") (length shell-dirstack)) ((looking-at "=\\([0-9]+\\)") (string-to-number (buffer-substring (match-beginning 1) (match-end 1))))))) (cond ((null index) nil) ((>= index (length stack)) (error "Directory stack not that deep.")) (t (replace-match (file-name-as-directory (nth index stack)) t t) (message "Directory item: %d" index) t)))))) (defun shell-strip-ctrl-m (&optional string) "Strip trailing `^M' characters from the current output group. This function could be in the list `comint-output-filter-functions' or bound to a key." (interactive) (let ((pmark (process-mark (get-buffer-process (current-buffer))))) (save-excursion (goto-char (if (interactive-p) comint-last-input-end comint-last-output-start)) (while (re-search-forward "\r+$" pmark t) (replace-match "" t t))))) (provide 'shell) ;;; shell.el ends here n shell-strip-ctrl-m (&optional string) "Strip trailing `^M' characters from the current output group. This function could be in the list `comint-output-filter-functions' or bound to a key." (interactive) (let ((pmark (process-mark (get-buffer-process (current-buffer))))) (save-excursion (goto-char (if (interactive-emacs-19_28/lisp/shell.elc 644 23 204 46423 6027634703 10533 ;ELC ;;; compiled by LEVITTE@eliza.e.kth.se on Tue Sep 19 11:03:04 1995 ;;; from file ED1928:[LISP]SHELL.EL ;;; emacs version 19.28.97. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`ED1928:[LISP]SHELL.EL' was compiled for Emacs 19")) (require (quote comint)) (defvar shell-prompt-pattern "^[^#$%>\n]*[#$%>] *" "\ Regexp to match prompts in the inferior shell. Defaults to \"^[^#$%>\\n]*[#$%>] *\", which works pretty well. This variable is used to initialise `comint-prompt-regexp' in the shell buffer. The pattern should probably not match more than one line. If it does, shell-mode may become confused trying to distinguish prompt from input on lines which don't start with a prompt. This is a fine thing to set in your `.emacs' file.") (defvar shell-completion-fignore nil "\ *List of suffixes to be disregarded during file/command completion. This variable is used to initialize `comint-completion-fignore' in the shell buffer. The default is nil, for compatibility with most shells. Some people like (\"~\" \"#\" \"%\"). This is a fine thing to set in your `.emacs' file.") (defvar shell-delimiter-argument-list (quote (124 38 60 62 40 41 59)) "\ List of characters to recognise as separate arguments. This variable is used to initialize `comint-delimiter-argument-list' in the shell buffer. The default is (?\\| ?& ?< ?> ?\\( ?\\) ?\\;). This is a fine thing to set in your `.emacs' file.") (defvar shell-dynamic-complete-functions (quote (comint-replace-by-expanded-history shell-dynamic-complete-environment-variable shell-dynamic-complete-command shell-replace-by-expanded-directory comint-dynamic-complete-filename)) "\ List of functions called to perform completion. This variable is used to initialise `comint-dynamic-complete-functions' in the shell buffer. This is a fine thing to set in your `.emacs' file.") (defvar shell-command-regexp "[^;&|\n]+" "\ *Regexp to match a single command within a pipeline. This is used for directory tracking and does not do a perfect job.") (defvar shell-completion-execonly t "\ *If non-nil, use executable files only for completion candidates. This mirrors the optional behavior of tcsh. Detecting executability of files may slow command completion considerably.") (defvar shell-popd-regexp "popd" "\ *Regexp to match subshell commands equivalent to popd.") (defvar shell-pushd-regexp "pushd" "\ *Regexp to match subshell commands equivalent to pushd.") (defvar shell-pushd-tohome nil "\ *If non-nil, make pushd with no arg behave as \"pushd ~\" (like cd). This mirrors the optional behavior of tcsh.") (defvar shell-pushd-dextract nil "\ *If non-nil, make \"pushd +n\" pop the nth dir to the stack top. This mirrors the optional behavior of tcsh.") (defvar shell-pushd-dunique nil "\ *If non-nil, make pushd only add unique directories to the stack. This mirrors the optional behavior of tcsh.") (defvar shell-cd-regexp "cd" "\ *Regexp to match subshell commands equivalent to cd.") (defvar explicit-shell-file-name nil "\ *If non-nil, is file name to use for explicitly requested inferior shell.") (defvar explicit-csh-args (byte-code "Á=ƒ‡Ç" [system-type hpux ("-i" "-T") ("-i")] 2) "\ *Args passed to inferior shell by M-x shell, if the shell is csh. Value is a list of strings, which may be nil.") (defvar shell-input-autoexpand (quote history) "\ *If non-nil, expand input command history references on completion. This mirrors the optional behavior of tcsh (its autoexpand and histlit). If the value is `input', then the expansion is seen on input. If the value is `history', then the expansion is only when inserting into the buffer's input ring. See also `comint-magic-space' and `comint-dynamic-complete'. This variable supplies a default for `comint-input-autoexpand', for Shell mode only.") (defvar shell-dirstack nil "\ List of directories saved by pushd in this buffer's shell. Thus, this does not include the shell's current directory.") (defvar shell-dirtrackp t "\ Non-nil in a shell buffer means directory tracking is enabled.") (defvar shell-last-dir nil "\ Keep track of last directory for ksh `cd -' command.") (defvar shell-dirstack-query nil "\ Command used by `shell-resync-dir' to query the shell.") (byte-code "ÀÁ!„ „<Ã\f!Å ÆÇ#ˆÅ ÈÉ#ˆÅ ÊË#ˆÅ ÌÍ#ˆÎÏ Ð\"ÑÒÓ$ˆÎÏ Ô\"ÕÖ×$ˆÂ‡" [boundp shell-mode-map nil copy-keymap comint-mode-map define-key "" shell-forward-command "" shell-backward-command " " comint-dynamic-complete "¿" comint-dynamic-list-filename-completions define-key-after lookup-key [menu-bar completion] [complete-env-variable] ("Complete Env. Variable Name" . shell-dynamic-complete-environment-variable) complete-file [menu-bar completion] [expand-directory] ("Expand Directory Reference" . shell-replace-by-expanded-directory) complete-expand] 5) (defvar shell-mode-hook nil "\ *Hook for customising Shell mode.") (defalias 'shell-mode #[nil "À ˆÁÃÅ!ˆ \n \f ÏÐ!ˆÏÑ!ˆÒÒÏÔ!ˆÕÖ×Ø\"ˆÛÜÝp!!@!ßà!†eᘃYâ‚e㘃dä‚eå‰&皃pÒ&èé\"ƒ|ê‚}ë,)íî!ˆïÕ!‡" [comint-mode shell-mode major-mode "Shell" mode-name use-local-map shell-mode-map shell-prompt-pattern comint-prompt-regexp shell-completion-fignore comint-completion-fignore shell-delimiter-argument-list comint-delimiter-argument-list shell-dynamic-complete-functions comint-dynamic-complete-functions make-local-variable paragraph-start shell-dirstack nil shell-last-dir shell-dirtrackp t add-hook comint-input-filter-functions shell-directory-tracker shell-input-autoexpand comint-input-autoexpand file-name-nondirectory process-command get-buffer-process shell getenv "HISTFILE" "bash" "~/.bash_history" "ksh" "~/.sh_history" "~/.history" comint-input-ring-file-name "/dev/null" string-match "^k?sh$" "pwd" "dirs" shell-dirstack-query run-hooks shell-mode-hook comint-read-input-ring] 5 "\ Major mode for interacting with an inferior shell. Return after the end of the process' output sends the text from the end of process to the end of the current line. Return before end of process output copies the current line (except for the prompt) to the end of the buffer and sends it. M-x send-invisible reads a line of text without echoing it, and sends it to the shell. This is useful for entering passwords. Or, add the function `comint-watch-for-password-prompt' to `comint-output-filter-functions'. If you accidentally suspend your process, use \\[comint-continue-subjob] to continue it. cd, pushd and popd commands given to the shell are watched by Emacs to keep this buffer's default directory the same as the shell's working directory. M-x dirs queries the shell and resyncs Emacs' idea of what the current directory stack is. M-x dirtrack-toggle turns directory tracking on and off. \\{shell-mode-map} Customization: Entry to this mode runs the hooks on `comint-mode-hook' and `shell-mode-hook' (in that order). Before each input, the hooks on `comint-input-filter-functions' are run. After each shell output, the hooks on `comint-output-filter-functions' are run. Variables `shell-cd-regexp', `shell-pushd-regexp' and `shell-popd-regexp' are used to match their respective commands, while `shell-pushd-tohome', `shell-pushd-dextract' and `shell-pushd-dunique' control the behavior of the relevant command. Variables `comint-completion-autolist', `comint-completion-addsuffix', `comint-completion-recexact' and `comint-completion-fignore' control the behavior of file name, command name and variable name completion. Variable `shell-completion-execonly' controls the behavior of command name completion. Variable `shell-completion-fignore' is used to initialise the value of `comint-completion-fignore'. Variables `comint-input-ring-file-name' and `comint-input-autoexpand' control the initialisation of the input ring history, and history expansion. Variables `comint-output-filter-functions', a hook, and `comint-scroll-to-bottom-on-input' and `comint-scroll-to-bottom-on-output' control whether input and output cause the window to scroll to the end of the buffer." nil]) (defalias 'shell #[nil "ÀÁ!„n\n†\"ÃÄ!†\"ÃÅ!†\"Ç=ƒ!È‚\"É\nË\n!\fÍÎ\f!PÐÑ\fÒQ!ÔÕÖ\n×!…Iƒ[Ø!ƒ[J‚gÇ=ƒfÙ‚gÚ%qˆÛ ˆ,ÜÁ!‡" [comint-check-proc "*shell*" explicit-shell-file-name getenv "ESHELL" "SHELL" system-type vax-vms "*dcl*" "/bin/sh" prog file-name-nondirectory name "~/.emacs_" make-legal-file-name startfile intern-soft "explicit-" "-args" xargs-name apply make-comint "shell" file-exists-p boundp ("") ("-i") shell-mode switch-to-buffer] 7 "\ Run an inferior shell, with I/O through buffer *shell*. If buffer exists but shell process is not running, make new shell. If buffer exists and shell process is running, just switch to buffer `*shell*'. Program used comes from variable `explicit-shell-file-name', or (if that is nil) from the ESHELL environment variable, or else from SHELL if there is no ESHELL. If a file `~/.emacs_SHELLNAME' exists, it is given as initial input (Note that this may lose due to a timing error if the shell discards input when it starts up.) The buffer is put in Shell mode, giving commands for sending input and controlling the subjobs of the shell. See `shell-mode'. See also the variable `shell-prompt-pattern'. The shell file name (sans directories) is used to make a symbol name such as `explicit-csh-args'. If that symbol is a variable, its value is used as a list of arguments when invoking the shell. Otherwise, one argument `-i' is passed to the shell. (Type \\[describe-mode] in the shell buffer for a list of commands.)" nil]) (defalias 'shell-directory-tracker #[(str) "…ÁÂÇ" [shell-dirtrackp chdir-failure (byte-code "ÀÁ\n\"ˆÃ•Ä‰‰‰ À\n\n #…±Ã•Ë\n OÉ#Ë\n Ỏ#À \"Ã=ƒOÎÏ!!ˆ‚£À\"Ã=ƒdÑÏ!!ˆ‚£À\"Ã=ƒyÓÏ!!ˆ‚£Õ>ƒ£ÀÖ\"ƒ£À×\"ÃUƒ£Ë\n O؉#ÓÏ !!ˆÀÙ\n#ˆÃ• ‚-‡" [string-match "^\\(\\s\\|[; ]\\)*" str 0 nil arg2 arg1 cmd end start shell-command-regexp comint-arguments 1 shell-popd-regexp shell-process-popd substitute-in-file-name shell-pushd-regexp shell-process-pushd shell-cd-regexp shell-process-cd system-type (vax-vms axp-vms) "^set$" "^def\\(a\\(u\\(lt?\\)?\\)?\\)?$" 2 "\\(\\s\\|[; ]\\)*"] 5) ((error "Couldn't cd"))] 3 "\ Tracks cd, pushd and popd commands issued to the shell. This function is called on each input passed to the shell. It watches for cd, pushd and popd commands and sets the buffer's default directory to track these commands. You may toggle this tracking on and off with M-x dirtrack-toggle. If emacs gets confused, you can resync with the shell with M-x dirs. See variables `shell-cd-regexp', `shell-pushd-regexp', and `shell-popd-regexp', while `shell-pushd-tohome', `shell-pushd-dextract' and `shell-pushd-dunique' control the behavior of the relevant command. Environment variables are expanded, see function `substitute-in-file-name'."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"‡" [defalias shell-process-popd #[(arg) "À !†‰ƒ# ÂUƒ#\fƒ#Å\f@!ˆ\fAÆ ‚S ƒP ÂVƒP \fGXƒPÇ\fB S›‰ ‰AA¡ˆAÆ *‚SÊË!)‡" [shell-extract-num arg 0 num shell-dirstack cd shell-dirstack-message nil ds cell error "Couldn't popd"] 3] shell-prefixed-directory-name #[(dir) "Á>ƒ+\n\nƒ$ÄÅ\n\"ƒ$\nÆÇ\nȔȕO–\"‰„\n†) )‡ GÊUƒ5\n‡Ë\n!ƒ@ \nP‡Ì\n!‡" [system-type (vax-vms axp-vms) dir old-dir string-match "^\\([A-Za-z$_][A-Za-z$_]*\\):?$" vms-system-info "LOGICAL" 1 comint-file-name-prefix 0 file-name-absolute-p expand-file-name] 5] shell-process-cd #[(arg) "GÁUƒ \nÃP‚Ęƒ ‚Æ!É!ˆÊ )‡" [arg 0 comint-file-name-prefix "~" "-" shell-last-dir shell-prefixed-directory-name new-dir default-directory cd shell-dirstack-message] 2] shell-process-pushd #[(arg) "À ! GÃUƒ;\fƒÅÇP!‚Ôƒ5 \nË@!ˆ\nABÌ )‚ÔÍÎ!‚Ô\n§ƒ³\nGVƒNÍÏ!‚Ô\nÃUƒ\\ÐÍÑ!!‚Ôƒ|\nS8Ô !ˆÅ !ˆË!ˆÌ )‚Ô B‰G\n›Ø\nZØ!›!Ú\"Ë@!ˆAÌ -‚Ô ËÝ !!ˆƒÊ„ÑBÌ ))‡" [shell-extract-num arg num 0 shell-pushd-tohome shell-process-pushd comint-file-name-prefix "~" shell-dirstack default-directory old cd shell-dirstack-message message "Directory stack empty." "Directory stack not that deep." error "Couldn't cd." shell-pushd-dextract dir shell-process-popd ds dslen front reverse back append new-ds old-wd shell-prefixed-directory-name shell-pushd-dunique] 5] shell-extract-num #[(str) "ÀÁ\n\"…\nÃ\n!‡" [string-match "^\\+[1-9][0-9]*$" str string-to-int] 3]] 3) (defalias 'shell-dirtrack-toggle #[nil "?Áƒ ÂÄ\"‡" [shell-dirtrackp message "Directory tracking %s" "ON" "OFF"] 3 "\ Turn directory tracking on and off in a shell buffer." nil]) (defalias (quote dirtrack-toggle) (quote shell-dirtrack-toggle)) (defalias 'shell-resync-dirs #[nil "Àp! !‰bˆ\fcˆÅcˆÆÇ!ˆÈ \f\"ˆÈ Å\"ˆ `É“ˆ`\nÅcˆËÌ!ˆÍÎ!„?Ï !ˆ\nbˆ‚.) bˆÐÌ!ˆÇ”Ç•S{‰GÉÇÇWƒÕÖ#ˆ̔̕OPBÇ•‰‚ZŸÉØÙ.‡" [get-buffer-process proc process-mark pmark shell-dirstack-query "\n" sit-for 0 comint-send-string nil pt backward-char 1 looking-at ".+\n" accept-process-output delete-char dl dl-len ds i string-match "\\s *\\(\\S +\\)\\s *" comint-file-name-prefix (byte-code "À @!ˆ Aà ‡" [cd ds shell-dirstack shell-dirstack-message] 2) ((error (message "Couldn't cd.")))] 5 "\ Resync the buffer's idea of the current directory stack. This command queries the shell with the command bound to `shell-dirstack-query' (default \"dirs\"), reads the next line output and parses it to form the new directory stack. DON'T issue this command unless the buffer is at a shell prompt. Also, note that if some other subprocess decides to do output immediately after the query, its output will be taken as the new directory stack -- you lose. If this happens, just do the command again." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias dirs shell-resync-dirs shell-dirstack-message #[nil "À\n BÅÇ>ƒÀ‚ÉP!‰\nG \fƒ›\f@\fÍ>„K\fG YƒK\n\fÎ O˜ƒKÉ\f ÏOP\fÐ>„€ƒ€\fGGYƒ€\fÎGO˜ƒ€\fGÏO‰\fƒ€\f\f ˆ Ñ=ƒ\f‚‘Ò\f!ÓQ\fA)‚Ô !,‡" ["" msg default-directory shell-dirstack ds expand-file-name system-type (vax-vms axp-vms) comint-file-name-prefix "~/" home homelen dir (vax-vms axp-vms) 0 nil (vax-vms axp-vms) vax-vms directory-file-name " " message] 5]] 3) (defalias 'shell-forward-command #[(&optional arg) "ŠÀˆ`) ÄP Å$…ÇÈ!)‡" [nil limit re-search-forward shell-command-regexp "\\([;&|][ ]*\\)+" move arg skip-syntax-backward " "] 5 "\ Move forward across ARG shell command(s). Does not cross lines. See `shell-command-regexp'." "p"]) (defalias 'shell-backward-command #[(&optional arg) "ŠÀÁ!ˆ`)‰`VƒŠÃyˆ`)ÄÅ\n\"ˆÆÇÈ \"\nÊ $…/Ì”bˆÍÁw)‡" [comint-bol nil limit 0 skip-syntax-backward " " re-search-backward format "[;&|]+[ ]*\\(%s\\)" shell-command-regexp move arg 1 ";&|"] 6 "\ Move backward across ARG shell command(s). Does not cross lines. See `shell-command-regexp'." "p"]) (defalias 'shell-dynamic-complete-command #[nil "À ‰…( ÄŽÅÆ \"*?…(Ç”ŠÈÉ!ˆ`)=…(ÊË!ˆÌ )‡" [comint-match-partial-filename filename match-data match-data ((store-match-data match-data)) string-match "[~/]" 0 shell-backward-command 1 message "Completing command name..." shell-dynamic-complete-as-command] 4 "\ Dynamically complete the command at point. This function is similar to `comint-dynamic-complete-filename', except that it searches `exec-path' (minus the trailing emacs library path) for completion candidates. Note that this may not be the same as the shell's idea of the path. Completion is dependent on the value of `shell-completion-execonly', plus those that effect file completion. See `shell-dynamic-complete-as-command'. Returns t if successful." nil]) (defalias 'shell-dynamic-complete-as-command #[nil "À †ÁÃ\n!Å!AÈÉ\n!! \f…%ÍÎ\fÏ#ÁÒÁÁÒƒ°È×@†DØ!!Ù!…TÚ\f\"‰ƒ§@P„žƒ|Û\"„ž ˜„‹Ü!„žƒ—Þ!ƒžBA‰„ZA‰„;Òà\f\")‰!â>ƒÐƒÐÜÀ !„Ðãcˆ!. ‡" [comint-match-partial-filename "" filename file-name-nondirectory pathnondir reverse exec-path paths file-name-as-directory expand-file-name default-directory cwd comint-completion-fignore mapconcat #[(x) "À !ÂP‡" [regexp-quote x "$"] 2] "\\|" ignored-extensions path nil comps-in-path file filepath completions comint-directory "." file-accessible-directory-p file-name-all-completions string-match file-directory-p shell-completion-execonly file-executable-p comint-completion-addsuffix comint-dynamic-simple-complete success (sole shortest) " "] 5 "\ Dynamically complete at point as a command. See `shell-dynamic-complete-filename'. Returns t if successful."]) (defalias 'shell-match-partial-variable #[nil "Š`ÁÂÃÄ#ƒÅÆ!„Çuˆl†ÅÈ!?…)ÉÊ\"ˆË”Ë•{*‡" [limit re-search-backward "[^A-Za-z0-9_{}]" nil move looking-at "\\$" 1 "[^A-Za-z0-9_{}$]" re-search-forward "\\$?{?[A-Za-z0-9_]*}?" 0] 4 "\ Return the variable at point, or nil if non is found."]) (defalias 'shell-dynamic-complete-environment-variable #[nil "À ‰…Âà \"…ÄÅ!ˆÆ )‡" [shell-match-partial-variable variable string-match "^\\$" message "Completing variable name..." shell-dynamic-complete-as-environment-variable] 4 "\ Dynamically complete the environment variable at point. Completes if after a variable, i.e., if it starts with a \"$\". See `shell-dynamic-complete-as-environment-variable'. This function is similar to `comint-dynamic-complete-filename', except that it searches `process-environment' for completion candidates. Note that this may not be the same as the interpreter's idea of variable names. The main problem with this type of completion is that `process-environment' is the environment which Emacs started with. Emacs does not track changes to the environment made by the interpreter. Perhaps it would be more accurate if this function was called `shell-dynamic-complete-process-environment-variable'. Returns non-nil if successful." nil]) (defalias 'shell-dynamic-complete-as-environment-variable #[nil "À †Á‰ÃÄ\n\"†ÅÆOÈÉ\n\" \f Æ\fÎ \"‰Ð>ƒxÀ ‰ÃÑ\n\"ÆOÃÒ\n\"ƒGÓ‚SÃÔ\n\"ƒRÕ‚SÁ „^Á‚n×ØÙ!!!ƒmÚ‚nÛ±ˆ,.‡" [shell-match-partial-variable "" var string-match "[^$({]\\|$" 0 nil variable mapcar #[(x) "ÁÂÃ\"O‡" [x 0 string-match "="] 5] process-environment variables comint-completion-addsuffix addsuffix comint-dynamic-simple-complete success (sole shortest) "[^$({]" "{" "}" "(" ")" protection file-directory-p comint-directory getenv "/" " " suffix] 5 "\ Dynamically complete at point as an environment variable. Used by `shell-dynamic-complete-environment-variable'. Uses `comint-dynamic-simple-complete'."]) (defalias 'shell-replace-by-expanded-directory #[nil "À …UŠÁ”bˆ\n BÄÅ!ƒ G‚%ÄÆ!…%ÇȔȕ{! \n „2Ë‚T \nGYƒAÌÍ!‚TÎÏ \n8!Љ#ˆÑÒ \"ˆÐ+‡" [comint-match-partial-filename 0 default-directory shell-dirstack looking-at "=-/?" "=\\([0-9]+\\)" string-to-number 1 index stack nil error "Directory stack not that deep." replace-match file-name-as-directory t message "Directory item: %d"] 4 "\ Expand directory stack reference before point. Directory stack references are of the form \"=digit\" or \"=-\". See `default-directory' and `shell-dirstack'. Returns t if successful." nil]) (defalias 'shell-strip-ctrl-m #[(&optional string) "ÀÁp!!Štƒ ‚\fbˆÅÆ\nÇ#…#ÈÉlj#ˆ‚*‡" [process-mark get-buffer-process pmark comint-last-input-end comint-last-output-start re-search-forward " +$" t replace-match ""] 4 "\ Strip trailing `^M' characters from the current output group. This function could be in the list `comint-output-filter-functions' or bound to a key." nil]) (provide (quote shell)) m \"=digit\" or \"=-\". See `default-directory' and `shell-dirstack'. Returns t if successful." nil]) (defalias 'shell-strip-ctrl-m #[(&optional string) "ÀÁp!!Štƒ ‚\fbˆÅÆ\nÇ#…#ÈÉlj#ˆ‚*‡" [process-mark get-buffer-process pmark coemacs-19_28/lisp/term/ 755 23 204 0 6027033010 7550 emacs-19_28/src/$changelog$.txt 644 23 204 40653 6027634704 11357 Tue Sep 19 21:20:14 1995 Richard Levitte * fileio.c (Fexpand_file_name): [VMS] enhanced the functionality of expand-file-name to correctly expand some combinations of `-' in directory specifications. Sun Sep 17 03:05:46 1995 Richard Levitte * descrip.mms_in_in ([-.vms]temacs.opt): `emacs_widget_resources', `emacsFrameClassRec' and `emacsFrameClass' are added to the NON_SAVED_DATA collection. * widget.c: the variable `resources' is called `emacs_widget_resources' instead, and is made non-static, so it can be moved to the NON_SAVED_DATA collection. Sun Sep 10 00:48:26 1995 Richard Levitte * vmsproc.c (vms_make_pty): always make PTYs EIGHTBIT. Tue Sep 5 18:45:35 1995 Richard Levitte * dired.c (file_name_completion): to remove the last character of a Lisp_String by decrementing the size was simply VERY wrong. garbage-collect could get very confused by that. Corrected. Sat Jun 10 12:30:57 1995 Richard Levitte * fileio.c (Finsert_file_contents): changed an #ifdef to include VMS as well, since comparing the buffer with the file does not always work very well. * callproc.c, emacs.c, fileio.c, process.c, sysdep.c: changed calls to strerror to err_str, which uses vaxc$errno whenever needed. * fileio.c: on VMS, double_dollars is a noop, since $foo is not expanded, and $$ are not converted to $, by substitute_file_name. Sat Feb 25 10:40:59 1995 Richard Levitte (LEVITTE@eliza.e.kth.se) * vmsgmalloc.c (__default_morecore, __default_lesscore): changed to use sys$cretva, sys$deltva and sys$expreg, since that's the only way to know if you happen to be tampering with protected memory. Also, the initial buffer is removed. Instead, with some cooperation from vmsmap.c and emacs.c, an initial chunk of heap is allocated, and is saved in the dump. This means that there's no need to handle two heaps anymore. Fri Nov 25 09:18:37 1994 Richard Levitte (LEVITTE@eliza.e.kth.se) * config.h_in: added NETLIB. * vmsproc.h (VMS_CHAN_STUFF): changed chan to be of type unsigned long, to accomodate for NETLIB's 32-bit context pointer. Also made net.net_buffer a descriptor, to be able to work correctly with tcp_receive(). * vmsproc.c: Made changes to support NETLIB. * process.c: likewise. * lread.c: always include stdlib.h when on VMS. * sysdep.c (opendir, readdir): changed to handle the lack of files correctly. (sys_access): bogus `acces = flags;' changed to `flags = acces;'. Also, the file is closed directly after the open, since we might otherwise get hanging channels. Handle invalid ACEs correctly. * xfns.c: include "gray.xmb" instead of "[.bitmaps]gray.xbm". * xmenu.c: include "XMenu.h" instead of "../oldXMenu/XMenu.h". * s/vms.h: added support for NETLIB (requires SOCKETSHR). * lisp.h: define ONE to be 1U on VMS and 1 otherwise, and change all 1's to be ONE. Mon Nov 21 17:10:50 1994 Richard Levitte (LEVITTE@elmer.e.kth.se) * callproc.c (relocate_fd): Made sure strerror is used instead of looking directly at sys_errlist. * emacs.c (main): likewise. * fileio.c (report_file_error): likewise. * process.c (list_processes_1, wait_reading_process_input, sigchld_handler): likewise. * sysdep.c (strerror): defined if HAVE_STRERROR is not defined. * config.h_in: Added HAVE_STRERROR. Fri Aug 5 15:24:40 1994 Richard Levitte (LEVITTE@elmer.e.kth.se) * callproc.c (call-process): Check the arguments to see if the call was like "/bin/sh -c" on Unix, and do something wise about it. * descrip.mms_in_in: Made sure the logical name `sys' is correctly defined even when `sys_includes' is an empty string. Added vms-date.el in VMS_SUPPORT. Made sure Emacs gets a base address at 8K. Finally removed the ugly system-specific #ifdef's. * dired.c (file-name-all-completions-with-versions): New function. (file_name_completion): Changed to use optimal file patterns when looking for a file. Good for speed. (file_name_as_directory): Changed to become more reliable. (expand-file-name): Now always upcases the result. * process.c (start-process): Now does the same check as call-process, as described above. * sysdep.c (rename_sans_version): Changed `#ifdef __ALPHA' to `#ifdef __DECC'. * vmsfns.c (vms-expand-search-paths): Takes an optional extra argument, and is generally more reliable. * vmsmap.c: Changed `#ifdef __ALPHA' to `#ifdef __DECC'. * vmsproc.c (hack_vms_program_name): Now handles the case when some arguments have sneaked into the program name string. (create_process): like call-process and start-process, described above. * xterm.c: Changed to use the Compose Key as Meta key in some cases. (x_find_modifier_meanings): Doesn't try to check codes that are zero any more. Wed Jun 29 18:55:27 1994 Richard Levitte (LEVITTE@elmer.e.kth.se) * vmsfns.c (Fvms_expand_search_paths): Takes one optional second argument which tells it if it should expand the path completelly, or just so the path will be unique. (expand_search_paths): Modified accordingly, and removed a bug for the case the file would not exist. * xterm.c (x_find_modifier_meanings, XTread_socket): Add some code to make XK_Multi_key to act as a Meta key in some cases. Fri May 20 14:27:01 1994 Richard Levitte (LEVITTE@elmer.e.kth.se) * descrip.mms_in_in: the targets `all' and `all_debug' are now dependent on $(OLDXMENU). The target is now using the script [-.vms]makedoc.com. The redefinition of `CPP' is now commented out. The target `really-oldXMenu' is now restored. The target `mostlyclean' now correctly removes the dump file. * s/vms.h: Changed to set up the use of the old MultiNet style. * sysdep.c: Always include . Added a debug line. * vmsproc.c(select): always setup the bits in allMask, even when rdsc is 0. Sun Apr 10 16:32:51 1994 Richard Levitte (LEVITTE@eliza.e.kth.se) * dired.c (file_name_completion): VMS needs to GCprotect save_file as well. * fileio.c (report_file_error): Apparently, there might be cases when sys_errlist[errno] is NULL, so protect against it. * fileio.c (Fcopy_file): Make some changes so chmod on VMS doesn't reset the modification time of the file. * systime.h: define the macro USE_UTIME, and include utime.h. * vmsproc.c (select): Changed to return -1 if an interrupt occured. This is somewhat magic, since all we handle are interrupts. * xselect.c (x_decline_selection_request): Added a call to XFlushQueue (); Tue Mar 29 12:26:46 1994 Richard Levitte (LEVITTE@eliza.e.kth.se) * dired.c (file_name_completion): Added GC protection of some variables. Thu Mar 24 10:50:06 1994 Richard Levitte (LEVITTE@eliza.e.kth.se) * sysdep.c (sys_write): Changed so fixed-format files can be written properly. * vmsproc.c (select): Changed to return -1 when an interrupt occurs. Sun Mar 20 21:36:42 1994 Richard Levitte (LEVITTE@eliza.e.kth.se) * alloca.c: Now, the function follow_alloca_headers is officialy added. It's purpose is to be used from the debugger. * callproc.c: Added the possibility to give yet another numeric argument call-process and its' companions, to get the output from programs as messages in the echo area. Also corrected a few bugs. * descrip.mms_in_in: The object files are split up in even smaller groups now... * dired.c(file-name-all-completions-with-versions): New function. * dired.c(file_name_completion): Now knows how to expand a bunch of zeroes at the beginning of directory specifications. * regex.c: Made re_match_2 to be a wrapper around re_match_2_real, which does what re_match_2 did before. The reason for this is some potential alloca() problems. * sysdep.c: A small change permitting end_kbd_queue to know if there is an AST to cancel or not. * systime.h: Removed some potential variable problem. * vmsproc.c: A whole bunch of bugs removed. * vmstime.c(sys_gmtime): Changed to be carefull when offset is 0. * vmstime.h: Defines HAVE_TZNAME. * xfns.c: Three calls to XSelectAsyncEvent added. Now, selections work as expected. Wed Feb 23 00:47:15 1994 Richard Levitte (LEVITTE@eliza.e.kth.se) * alloca.c: Removed a bug. * config.h_in: Added the VMS-specific macro USE_DEBUG_HACK, which is used in DESCRIP.MMS_IN_IN. * descrip.mms_in_in: Removed a few bugs, and started using USE_DEBUG_HACK. * emacs.c (fatal_error_signal): Signal SS$_DEBUG instead of aborting. * emacs.c (main): Only use mtrace when debugging. * process.c (process_send_signal): Use SYS$FORCEX instead of trying to send ^Y to a process. * sysdep.c (kbd_input_ast): Extended the debug info when ASTDEBUG is defined. * sysdep.c (sys_getenv): Treat "TERM", "HOME", "PATH", "USER" in a special way. * termcap.c (tgetent): Is not dependent on the logical name EMACS_LIBRARY any more. Instead, let PATH_DATA decide where termcap.dat can be found. * vmsproc.c (vms_write_pty, vms_make_pty, vms_close_fd): Removed a bug in the handling of the PTD$ routines. Thu Feb 10 03:29:44 1994 Richard Levitte (LEVITTE@elmer.e.kth.se) * vmsproc.c (vms_close_fd,vms_make_pty): removed dum_PTY_BUFFERS, and changed the calls to LIB$*_VM_PAGES to valloc() and free(). Sun Feb 6 21:47:54 1994 Richard Levitte (LEVITTE@eliza.e.kth.se) * descrip.mms_in_in: Changed the dependency on oldXMenu so Emacs will not get linked every time you run MMS. Also, a few other clean ups. * dired.c: A change to handle version numbers better. * sysdep.c: Corrected a bug with terminal settings. Tue Jan 18 22:58:29 1994 Richard Levitte (LEVITTE@eliza.e.kth.se) * config.h.in: Changed the name PATH_SEPARATOR back to SEPCHAR. * dired.c (file_name_completion): Now really makes good use of opendir () and closedir (). Also handles completion of directories. * getpagesize.h: the page size on VMS is no longer hardcoded to 512, thanks to the AXP architecture. * keyboard.c (reinvoke_input_signal): Make this function work on VMS as well, by invoking an AST. * process.c: Some quantities should be static, but some functions in vmsproc.c need them, so don't make them static on VMS. * process.c (read_process_output, exec_sentinel): unbind_to was called with only 1 arg when 2 are needed. Qnil was added as second arg. * sysdep.c (change_input_fd) : Fixed to work on VMS. * sysdep.c (kbd_input_ast): Changed to do exactly the same operation as the input_available_signal and read_avail_input in keyboard.c. There's no more need for a separate AST routine for X-windows. * sysdep.c (opendir, readdir, closedir): Fixed to work on VMS. Also, opendir takes an optional second argument, which is used as a file pattern. * sysdep.c (rmdir): Fixed to work right on VMS. * sysdep.c (sys_translate_unix): Fixed to really treat a directory specification not starting with a slash as a relative spec. * sysdep.c (getpagesize): Added for the AXP architecture. * systime.h: Changed so VMS can specify microseconds also. * vmsgmalloc.c (__default_morecore): Changed to support the AXP architecture. * vmsmap.c: Changed to suport the AXP architecture. * vmstime.c (__vms_time_secs, __vms_time_usecs, __vms_set_secs, _vms_set_usecs, vms_ad_time, __vms_sub_time, __vms_negate_time): Added functions to better support the definitions in systime.h. * xfns.c (x_window): Connect the routine kbd_input_ast to the window event input stream, instead of vms_X_ast. * xrdb.c (search_magic_path): Use SEPCHAR instead of PATH_SEPARATOR. * xselect.c: Please, DO include termhooks.h. * xterm.c: If HAVE_FCNTL_H is not defined, include file.h instead of fcntl.h. Same goes for HAVE_PARAM_H and sys/param.h. * xterm.c (x_scroll_bar_create): Just as for x_window in xfns.c, connect the routine kbd_input_ast to the window event stream. * xterm.c (vms_X_ast): REMOVED. It is now obsolete. * xterm.c (x_term_init): Assign read_socket_hook, just as on Unix. * m/avms1-5.h: Added to support AXP/VMS. * s/template.h: Changed PATH_SEPARATOR back to SEPCHAR. * s/vms.h: #define SEPCHAR to ',' instead of PATH_SEPARATOR. * s/vms.h: Stop #defining malloc and friends to sys_malloc et al. Mon Dec 6 22:49:45 1993 Richard Levitte (LEVITTE@elin.e.kth.se) * sysdep.c (vms_low_readdir): New function to help the functions readdir and readdirver. * sysdep.c (opendir, closedir, readdir, readdirver): Modified to use the library functions LIB$FIND_FILE and LIB$FIND_FILE_END. Fri Jul 30 13:30:31 1993 Richard Levitte (LEVITTE@elin.e.kth.se) * callproc.c: Made some changes for VMS GNU C. Not tested. * callproc.c (call_process_kill, call_process_cleanup): Small changes for VMS. * callproc.c (call-process): Some changes to make this work on VMS. * config.h.in: Added UCX, MULTINET to designate which (by Emacs supported) TCP/IP package should be used. * config.h.in: Added PATH_SEPARATOR to hold the character which separates the entries in a path. * dired.c (file-attributes): Now returns a list of three numbers for the inode. * emacs.c (init_cmdargs): Changed for VMS so invocation-name won't hold a file name with extension and version number. * emacs.c (decode_env_path): Now uses PATH_SEPARATOR instead of SEPCHAR. * fileio.c (file_name_as_directory): Changed for VMS to handle the [000000] directory entry (the root). * fileio.c (expand-file-name): Changed for VMS to handle the [000000] directory entry, and to convert the delimiters < and > to [ and ]. * floatfns (logb): Make VMS do it the same way as USG. * keyboard.c (read_avail_input): Make this function available on VMS, but make it a dummy. * keyboard.c (interrupt_signal): Call sys$clrast () before signaling quit. sys$clrast () is an undocumented system service. * process.c [VMS]: Include the proper include files, depending on which TCP/IP package is used. Also made sys_siglist available again. * process.c (status_message): Now, Emacs is not prevented from using sys_siglist, so do not use sys_errlist anymore! Also, if the exit code has bit 0 set to 1, consider the process finished. * process.c (make_process, remove_process) [VMS]: Changed to store some proper data in the VMS process data structure. See vmsproc.h. * process.c (start-process) [VMS]: Changed to hack the program name to be called properly. * process.c (open-network-stream) [VMS]: On older versions of UCX, getservbyname () is just an entry with no real function, and thus returns -1. This is now handled. * process.c (deactivate_process, close_process_descs, read_process_output, send_process) [VMS]: Changed to reflect the changes in vmsproc.c. * process.c (process_send_signal) [VMS]: Changed to properly assign pid and gid. * s/template.h: changed SEPCHAR to PATH_SEPARATOR, for readability. * s/vms.h: #defines HAVE_PTYS. * s/vms.h: #defines PATH_SEPARATOR to ','. * s/vms.h: #defines HAVE_SOCKETS and HAVE_GETHOSTNAME if any TCP/IP package is used. * s/vms.h: #defines LIBS_STANDARD and C_SWITCH_SYSTEM conditionaly, depending on if we compile on OpenVMS AXP or VAX/VMS. * s/vms5-5.h: #defines HAVE_VMS_PTYS and HAVE_GETPPID. * sysdep.c (wait_for_termination) [VMS]: Isn't used here. The true definition is defined in vmsproc.c. * sysdep.c (kbd_input_ast): Changed to reflect changes in keyboard.c and vmsproc.c * sysdep.c (sys_sleep) [VMS]: Use timer #2 instead of #1, because the latter is used by VAX C alarm (). * sysdep.c ({request,unrequest}_sigio) [VMS]: Will not croak anymore. * sysdep.c (get_system_name) [VMS]: Uses gethostname () instead of looking directly at the env var SYS$NODE. * sysdep.c (rename_sans_version) [VMS]: Changed to reflect a change in one include file on OpenVMS AXP. Not yet tested. * sysdep.c [VMS]: Added sys_siglist. * systime.h [VMS]: Includes vmstime.h. * vmsfns.c (vms-system-info): Changed the handling of the logical names, to also take an index. This is useful when dealing with VMS search paths. * vmsfns.c (vms-expand-search-paths, expand_search_paths, vms_trnlnm): New functions. * vmsfns.c (vms_trnlog): Changed to take two arguments. * vmsgmalloc.c: Changed to reflect changes in gmalloc.c, and to handle two heaps a better way. * vmsmap.c: Changed slightly for VMS GNU C. * vmsproc.h, vmsproc.c: Lots of changes. * xfns.c (x_window) [VMS]: Connect an AST routine to the window event stream. * xrdb.c (search_magic_path): Use PATH_SEPARATOR instead of ':'. * xrbd.c [VMS]: Various changes to use the DECWindows/Motif file names and logical names. * xterm.c (x_scroll_bar_create) [VMS]: Connect an AST routine to the window event stream. * xterm.c (vms_X_ast) [VMS]: New function. * xterm.c (x_term_init) [VMS]: Do not assign read_socket_hook. nged slightly for VMS GNU C. * vmsproc.h, vmsproc.c: Lots of changes. * xfns.c (xemacs-19_28/src/bitmaps/ 755 23 204 0 6027033255 10073 emacs-19_28/src/chpdef.h 644 23 204 1611 6027634662 10133 #define CHP$_END 0 #define CHP$_ACCESS 1 #define CHP$_FLAGS 2 #define CHP$_PRIV 3 #define CHP$_ACMODE 4 #define CHP$_ACCLASS 5 #define CHP$_RIGHTS 6 #define CHP$_ADDRIGHTS 7 #define CHP$_MODE 8 #define CHP$_MODES 9 #define CHP$_MINCLASS 10 #define CHP$_MAXCLASS 11 #define CHP$_OWNER 12 #define CHP$_PROT 13 #define CHP$_ACL 14 #define CHP$_AUDITNAME 15 #define CHP$_ALARMNAME 16 #define CHP$_MATCHEDACE 17 #define CHP$_PRIVUSED 18 #define CHP$_MAX_CODE 19 #define CHP$_UIC 22 #define CHP$M_SYSPRV 1 #define CHP$M_BYPASS 2 #define CHP$M_UPGRADE 4 #define CHP$M_DOWNGRADE 8 #define CHP$M_GRPPRV 16 #define CHP$M_READALL 32 #define CHP$V_SYSPRV 0 #define CHP$V_BYPASS 1 #define CHP$V_UPGRADE 2 #define CHP$V_DOWNGRADE 3 #define CHP$V_GRPPRV 4 #define CHP$V_READALL 5 #define CHP$M_READ 1 #define CHP$M_WRITE 2 #define CHP$M_USEREADALL 4 #define CHP$V_READ 0 #define CHP$V_WRITE 1 #define CHP$V_USEREADALL 2 MATCHEDACE 17 #define CHP$_PRIVUSED 18 #define CHP$_MAX_CODE 19 #define CHP$_UIC 22 #define CHP$M_SYSPRV 1 #define CHP$emacs-19_28/src/fileio.c 644 23 204 371662 6027634704 10221 #include #include /* File IO for GNU Emacs. Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994 Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs 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 2, or (at your option) any later version. GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #include #include #include #ifdef HAVE_UNISTD_H #include #endif #if !defined (S_ISLNK) && defined (S_IFLNK) # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK) #endif #if !defined (S_ISREG) && defined (S_IFREG) # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG) #endif #ifdef VMS #include "vms-pwd.h" #else #include #endif #ifdef MSDOS #include "msdos.h" #include #endif #include #ifdef VMS #include "vmsdir.h" #include #include #include #endif #include #ifndef vax11c extern int errno; #endif #ifdef VMS #define err_str(a) ((a != EVMSERR) ? strerror(a) : strerror(a,vaxc$errno)) #else extern char *strerror (); #define err_str(a) (strerror(a)) #endif #ifdef APOLLO #include #endif #ifndef USG #ifndef VMS #ifndef BSD4_1 #define HAVE_FSYNC #endif #endif #endif #include "lisp.h" #include "intervals.h" #include "buffer.h" #include "window.h" #ifdef VMS #include #include #include #include #endif #include "systime.h" #ifdef HPUX #include #ifndef HPUX8 #ifndef HPUX9 #include #endif #endif #endif #ifndef O_WRONLY #define O_WRONLY 1 #endif #ifndef O_RDONLY #define O_RDONLY 0 #endif #define min(a, b) ((a) < (b) ? (a) : (b)) #define max(a, b) ((a) > (b) ? (a) : (b)) /* Nonzero during writing of auto-save files */ int auto_saving; /* Set by auto_save_1 to mode of original file so Fwrite_region will create a new file with the same mode as the original */ int auto_save_mode_bits; /* Alist of elements (REGEXP . HANDLER) for file names whose I/O is done with a special handler. */ Lisp_Object Vfile_name_handler_alist; /* Functions to be called to process text properties in inserted file. */ Lisp_Object Vafter_insert_file_functions; /* Functions to be called to create text property annotations for file. */ Lisp_Object Vwrite_region_annotate_functions; /* During build_annotations, each time an annotation function is called, this holds the annotations made by the previous functions. */ Lisp_Object Vwrite_region_annotations_so_far; /* File name in which we write a list of all our auto save files. */ Lisp_Object Vauto_save_list_file_name; /* Nonzero means, when reading a filename in the minibuffer, start out by inserting the default directory into the minibuffer. */ int insert_default_directory; /* On VMS, nonzero means write new files with record format stmlf. Zero means use var format. */ int vms_stmlf_recfm; /* These variables describe handlers that have "already" had a chance to handle the current operation. Vinhibit_file_name_handlers is a list of file name handlers. Vinhibit_file_name_operation is the operation being handled. If we try to handle that operation, we ignore those handlers. */ static Lisp_Object Vinhibit_file_name_handlers; static Lisp_Object Vinhibit_file_name_operation; Lisp_Object Qfile_error, Qfile_already_exists; Lisp_Object Qfile_name_history; Lisp_Object Qcar_less_than_car; report_file_error (string, data) char *string; Lisp_Object data; { Lisp_Object errstring; errstring = build_string (err_str (errno)); /* System error messages are capitalized. Downcase the initial unless it is followed by a slash. */ if (XSTRING (errstring)->data[1] != '/') XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]); while (1) Fsignal (Qfile_error, Fcons (build_string (string), Fcons (errstring, data))); } close_file_unwind (fd) Lisp_Object fd; { close (XFASTINT (fd)); } /* Restore point, having saved it as a marker. */ restore_point_unwind (location) Lisp_Object location; { SET_PT (marker_position (location)); Fset_marker (location, Qnil, Qnil); } Lisp_Object Qexpand_file_name; Lisp_Object Qdirectory_file_name; Lisp_Object Qfile_name_directory; Lisp_Object Qfile_name_nondirectory; Lisp_Object Qunhandled_file_name_directory; Lisp_Object Qfile_name_as_directory; Lisp_Object Qcopy_file; Lisp_Object Qmake_directory_internal; Lisp_Object Qdelete_directory; Lisp_Object Qdelete_file; Lisp_Object Qrename_file; Lisp_Object Qadd_name_to_file; Lisp_Object Qmake_symbolic_link; Lisp_Object Qfile_exists_p; Lisp_Object Qfile_executable_p; Lisp_Object Qfile_readable_p; Lisp_Object Qfile_symlink_p; Lisp_Object Qfile_writable_p; Lisp_Object Qfile_directory_p; Lisp_Object Qfile_accessible_directory_p; Lisp_Object Qfile_modes; Lisp_Object Qset_file_modes; Lisp_Object Qfile_newer_than_file_p; Lisp_Object Qinsert_file_contents; Lisp_Object Qwrite_region; Lisp_Object Qverify_visited_file_modtime; Lisp_Object Qset_visited_file_modtime; DEFUN ("find-file-name-handler", Ffind_file_name_handler, Sfind_file_name_handler, 2, 2, 0, "Return FILENAME's handler function for OPERATION, if it has one.\n\ Otherwise, return nil.\n\ A file name is handled if one of the regular expressions in\n\ `file-name-handler-alist' matches it.\n\n\ If OPERATION equals `inhibit-file-name-operation', then we ignore\n\ any handlers that are members of `inhibit-file-name-handlers',\n\ but we still do run any other handlers. This lets handlers\n\ use the standard functions without calling themselves recursively.") (filename, operation) Lisp_Object filename, operation; { /* This function must not munge the match data. */ Lisp_Object chain, inhibited_handlers; CHECK_STRING (filename, 0); if (EQ (operation, Vinhibit_file_name_operation)) inhibited_handlers = Vinhibit_file_name_handlers; else inhibited_handlers = Qnil; for (chain = Vfile_name_handler_alist; XTYPE (chain) == Lisp_Cons; chain = XCONS (chain)->cdr) { Lisp_Object elt; elt = XCONS (chain)->car; if (XTYPE (elt) == Lisp_Cons) { Lisp_Object string; string = XCONS (elt)->car; if (XTYPE (string) == Lisp_String && fast_string_match (string, filename) >= 0) { Lisp_Object handler, tem; handler = XCONS (elt)->cdr; tem = Fmemq (handler, inhibited_handlers); if (NILP (tem)) return handler; } } QUIT; } return Qnil; } DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory, 1, 1, 0, "Return the directory component in file name NAME.\n\ Return nil if NAME does not include a directory.\n\ Otherwise return a directory spec.\n\ Given a Unix syntax file name, returns a string ending in slash;\n\ on VMS, perhaps instead a string ending in `:', `]' or `>'.") (file) Lisp_Object file; { register unsigned char *beg; register unsigned char *p; Lisp_Object handler; CHECK_STRING (file, 0); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (file, Qfile_name_directory); if (!NILP (handler)) return call2 (handler, Qfile_name_directory, file); #ifdef FILE_SYSTEM_CASE file = FILE_SYSTEM_CASE (file); #endif beg = XSTRING (file)->data; p = beg + XSTRING (file)->size; while (p != beg && p[-1] != '/' #ifdef VMS && p[-1] != ':' && p[-1] != ']' && p[-1] != '>' #endif /* VMS */ #ifdef MSDOS && p[-1] != ':' && p[-1] != '\\' #endif ) p--; if (p == beg) return Qnil; #ifdef MSDOS /* Expansion of "c:" to drive and default directory. */ if (p == beg + 2 && beg[1] == ':') { int drive = (*beg) - 'a'; /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */ unsigned char *res = alloca (MAXPATHLEN + 5); if (getdefdir (drive + 1, res + 2)) { res[0] = drive + 'a'; res[1] = ':'; if (res[strlen (res) - 1] != '/') strcat (res, "/"); beg = res; p = beg + strlen (beg); } } #endif return make_string (beg, p - beg); } DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, Sfile_name_nondirectory, 1, 1, 0, "Return file name NAME sans its directory.\n\ For example, in a Unix-syntax file name,\n\ this is everything after the last slash,\n\ or the entire name if it contains no slash.") (file) Lisp_Object file; { register unsigned char *beg, *p, *end; Lisp_Object handler; CHECK_STRING (file, 0); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (file, Qfile_name_nondirectory); if (!NILP (handler)) return call2 (handler, Qfile_name_nondirectory, file); beg = XSTRING (file)->data; end = p = beg + XSTRING (file)->size; while (p != beg && p[-1] != '/' #ifdef VMS && p[-1] != ':' && p[-1] != ']' && p[-1] != '>' #endif /* VMS */ #ifdef MSDOS && p[-1] != ':' && p[-1] != '\\' #endif ) p--; return make_string (p, end - p); } DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, Sunhandled_file_name_directory, 1, 1, 0, "Return a directly usable directory name somehow associated with FILENAME.\n\ A `directly usable' directory name is one that may be used without the\n\ intervention of any file handler.\n\ If FILENAME is a directly usable file itself, return\n\ (file-name-directory FILENAME).\n\ The `call-process' and `start-process' functions use this function to\n\ get a current directory to run processes in.") (filename) Lisp_Object filename; { Lisp_Object handler; /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory); if (!NILP (handler)) return call2 (handler, Qunhandled_file_name_directory, filename); return Ffile_name_directory (filename); } char * file_name_as_directory (out, in) char *out, *in; { int size = strlen (in) - 1; int ext_point = 0; strcpy (out, in); #ifdef VMS /* Is it already a directory string? */ if (in[size] == ':' || in[size] == ']' || in[size] == '>') return out; /* Is it a VMS directory file name? If so, hack VMS syntax. */ else if (! index (in, '/')) { ext_point = 1; if (size > 3 && (! strcmp (&in[size - 3], ".DIR") || ! strcmp (&in[size - 3], ".dir"))) ext_point = -3; else if (size > 5 && (! strncmp (&in[size - 5], ".DIR", 4) || ! strncmp (&in[size - 5], ".dir", 4)) && (in[size - 1] == '.' || in[size - 1] == ';') && in[size] == '1') ext_point = -5; } if (ext_point != 0) { register char *p, *dot; char brack; /* dir:[000000]x.dir --> dir:x.dir --> dir:[x] dir:[000000.x]y.dir --> dir:[x]y.dir --> dir:[x.y] but dir:[000000.000000]x.dir --> dir:[000000.000000.x] dir:[000000.000000.x]y.dir --> dir:[000000.000000.x.y] */ static char tem[256]; p = dot = strchr(in,':'); if (p != 0 && (p[1] == '[' || p[1] == '<')) { p += 2; if (strncmp(p,"000000",6) == 0) { p += 6; if (strncmp(p,".000000",7) != 0 && (*p == ']' || *p == '>' || *p == '.')) { size = dot - in + 1; strncpy(tem, in, size); if (*p == '.') tem[size++] = '['; strcpy(tem + size, p + 1); in = tem; size = strlen(in) - 1; } } } /* x.dir -> [.x] dir:x.dir --> dir:[x] dir:[x]y.dir --> dir:[x.y] */ p = in + size; while (p != in && *p != ':' && *p != '>' && *p != ']') p--; { char *emergency_dir = 0; int emergency_point = 0; /* relative to the end of `out' */ if (p != in) { strncpy (out, in, p - in); out[p - in] = '\0'; if (*p == ':') { brack = ']'; strcat (out, ":["); emergency_dir = "000000"; emergency_point = 0; } else { brack = *p; strcat (out, "."); emergency_dir = ""; emergency_point = -1; } p++; } else { brack = ']'; strcpy (out, "[."); emergency_dir = ""; emergency_point = -2; } if (strncmp (p, "000000.", 7) == 0 && (strncmp (p+7, "000000", 6) != 0 || (p[13] != ']' && p[13] != '>' && p[13] != '.'))) p += 7; if (p < (in + size + ext_point)) { register copy_len = ((in + size + ext_point) - p); size = strlen (out) + copy_len; strncat (out, p, copy_len); } else { size = strlen (out) + emergency_point; strcpy (out + size, emergency_dir); size += strlen (emergency_dir); } } out[size++] = brack; out[size] = '\0'; } #else /* not VMS */ /* For Unix syntax, Append a slash if necessary */ #ifdef MSDOS if (out[size] != ':' && out[size] != '/' && out[size] != '\\') #else if (out[size] != '/') #endif strcat (out, "/"); #endif /* not VMS */ return out; } DEFUN ("file-name-as-directory", Ffile_name_as_directory, Sfile_name_as_directory, 1, 1, 0, "Return a string representing file FILENAME interpreted as a directory.\n\ This operation exists because a directory is also a file, but its name as\n\ a directory is different from its name as a file.\n\ The result can be used as the value of `default-directory'\n\ or passed as second argument to `expand-file-name'.\n\ For a Unix-syntax file name, just appends a slash.\n\ On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.") (file) Lisp_Object file; { char *buf; Lisp_Object handler; CHECK_STRING (file, 0); if (NILP (file)) return Qnil; /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (file, Qfile_name_as_directory); if (!NILP (handler)) return call2 (handler, Qfile_name_as_directory, file); buf = (char *) alloca (XSTRING (file)->size + 10); return build_string (file_name_as_directory (buf, XSTRING (file)->data)); } /* * Convert from directory name to filename. * On VMS: * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1 * On UNIX, it's simple: just make sure there is a terminating / * Value is nonzero if the string output is different from the input. */ directory_file_name (src, dst) char *src, *dst; { long slen; #ifdef VMS long rlen; char * ptr, * rptr; char bracket; struct FAB fab = cc$rms_fab; struct NAM nam = cc$rms_nam; char esa[NAM$C_MAXRSS]; #endif /* VMS */ slen = strlen (src); #ifdef VMS if (! index (src, '/') && (src[slen - 1] == ']' || src[slen - 1] == ':' || src[slen - 1] == '>')) { /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */ fab.fab$l_fna = src; fab.fab$b_fns = slen; fab.fab$l_nam = &nam; fab.fab$l_fop = FAB$M_NAM; nam.nam$l_esa = esa; nam.nam$b_ess = sizeof esa; nam.nam$b_nop |= NAM$M_SYNCHK; /* We call SYS$PARSE to handle such things as [--] for us. */ if (SYS$PARSE(&fab, 0, 0) == RMS$_NORMAL) { slen = nam.nam$b_esl; if (esa[slen - 1] == ';' && esa[slen - 2] == '.') slen -= 2; esa[slen] = '\0'; src = esa; } if (src[slen - 1] != ']' && src[slen - 1] != '>') { /* what about when we have logical_name:???? */ if (src[slen - 1] == ':') { /* Xlate logical name and see what we get */ ptr = strcpy (dst, src); /* upper case for getenv */ while (*ptr) { if ('a' <= *ptr && *ptr <= 'z') *ptr -= 040; ptr++; } dst[slen - 1] = 0; /* remove colon */ if (!(src = egetenv (dst))) return 0; /* should we jump to the beginning of this procedure? Good points: allows us to use logical names that xlate to Unix names, Bad points: can be a problem if we just translated to a device name... For now, I'll punt and always expect VMS names, and hope for the best! */ slen = strlen (src); if (src[slen - 1] != ']' && src[slen - 1] != '>') { /* no recursion here! */ strcpy (dst, src); return 0; } } else { /* not a directory spec */ strcpy (dst, src); return 0; } } bracket = src[slen - 1]; /* If bracket is ']' or '>', bracket - 2 is the corresponding opening bracket. */ ptr = index (src, bracket - 2); if (ptr == 0) { /* no opening bracket */ strcpy (dst, src); return 0; } if (!(rptr = rindex (src, '.'))) rptr = ptr; slen = rptr - src; strncpy (dst, src, slen); dst[slen] = '\0'; if (*rptr == '.') { dst[slen++] = bracket; dst[slen] = '\0'; } else { /* If we have the top-level of a rooted directory (i.e. xx:[000000]), then translate the device and recurse. */ if (dst[slen - 1] == ':' && dst[slen - 2] != ':' /* skip decnet nodes */ && strcmp(src + slen, "[000000]") == 0) { dst[slen - 1] = '\0'; if ((ptr = egetenv (dst)) && (rlen = strlen (ptr) - 1) > 0 && (ptr[rlen] == ']' || ptr[rlen] == '>') && ptr[rlen - 1] == '.') { char * buf = (char *) alloca (strlen (ptr) + 1); strcpy (buf, ptr); buf[rlen - 1] = ']'; buf[rlen] = '\0'; return directory_file_name (buf, dst); } else dst[slen - 1] = ':'; } strcat (dst, "[000000]"); slen += 8; } rptr++; rlen = strlen (rptr) - 1; strncat (dst, rptr, rlen); dst[slen + rlen] = '\0'; strcat (dst, ".DIR.1"); return 1; } #endif /* VMS */ /* Process as Unix format: just remove any final slash. But leave "/" unchanged; do not change it to "". */ strcpy (dst, src); if (slen > 1 #ifdef MSDOS && (dst[slen - 1] == '/' || dst[slen - 1] == '/') && dst[slen - 2] != ':' #else && dst[slen - 1] == '/' #endif ) dst[slen - 1] = 0; return 1; } DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name, 1, 1, 0, "Returns the file name of the directory named DIR.\n\ This is the name of the file that holds the data for the directory DIR.\n\ This operation exists because a directory is also a file, but its name as\n\ a directory is different from its name as a file.\n\ In Unix-syntax, this function just removes the final slash.\n\ On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\ it returns a file name such as \"[X]Y.DIR.1\".") (directory) Lisp_Object directory; { char *buf; Lisp_Object handler; CHECK_STRING (directory, 0); if (NILP (directory)) return Qnil; /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (directory, Qdirectory_file_name); if (!NILP (handler)) return call2 (handler, Qdirectory_file_name, directory); #ifdef VMS /* 20 extra chars is insufficient for VMS, since we might perform a logical name translation. an equivalence string can be up to 255 chars long, so grab that much extra space... - sss */ buf = (char *) alloca (XSTRING (directory)->size + 20 + 255); #else buf = (char *) alloca (XSTRING (directory)->size + 20); #endif directory_file_name (XSTRING (directory)->data, buf); return build_string (buf); } DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0, "Generate temporary file name (string) starting with PREFIX (a string).\n\ The Emacs process number forms part of the result,\n\ so there is no danger of generating a name being used by another process.") (prefix) Lisp_Object prefix; { Lisp_Object val; val = concat2 (prefix, build_string ("XXXXXX")); mktemp (XSTRING (val)->data); return val; } DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0, "Convert FILENAME to absolute, and canonicalize it.\n\ Second arg DEFAULT is directory to start with if FILENAME is relative\n\ (does not start with slash); if DEFAULT is nil or missing,\n\ the current buffer's value of default-directory is used.\n\ Path components that are `.' are removed, and \n\ path components followed by `..' are removed, along with the `..' itself;\n\ note that these simplifications are done without checking the resulting\n\ paths in the file system.\n\ An initial `~/' expands to your home directory.\n\ An initial `~USER/' expands to USER's home directory.\n\ See also the function `substitute-in-file-name'.\n\n\ On VMS, expand-file-name does a little more work. The following\n\ conversions are done:\n\ - [000000.foo] => [foo]\n\ - [000000.000000.foo] => [000000.000000.foo]\n\ - [000000.][foo] => [foo]\n\ - [000000][.foo] => [foo]\n\ - [000000][.000000] => [000000.000000]\n\ - [foo.][000000] => [foo]\n\ - [foo][.000000] => [foo.000000]\n\ - [foo.][000000.000000] => [foo.000000]\n\ - [foo.][000000.bar] => [foo.bar]\n\ - [foo][.000000.bar] => [foo.000000.bar]\n\ - [foo.][000000.000000.bar] => [foo.000000.bar]\n\ - [foo.][bar] => [foo.bar]\n\ - [foo][.bar] => [foo.bar]\n\ - [foo][bar] => [bar]\n\n\ Also, if <> has been used instead of [] as directory limiters, they\n\ are converted back to [].") (name, defalt) Lisp_Object name, defalt; { unsigned char *nm; register unsigned char *newdir, *p, *o; int tlen; unsigned char *target; struct passwd *pw; #ifdef VMS unsigned char * colon = 0; unsigned char * close = 0; unsigned char * slash = 0; unsigned char * brack = 0; int lbrack = 0, rbrack = 0; int dots = 0; int zeroes = -1; /* counts zeroes in [000000. construct */ unsigned char * firstbrack = 0, * lastbrack = 0; #endif /* VMS */ #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida */ int drive = -1; int relpath = 0; unsigned char *tmp, *defdir; #endif Lisp_Object handler; CHECK_STRING (name, 0); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (name, Qexpand_file_name); if (!NILP (handler)) return call3 (handler, Qexpand_file_name, name, defalt); /* Use the buffer's default-directory if DEFALT is omitted. */ if (NILP (defalt)) defalt = current_buffer->directory; CHECK_STRING (defalt, 1); /* Make sure DEFALT is properly expanded. It would be better to do this down below where we actually use defalt. Unfortunately, calling Fexpand_file_name recursively could invoke GC, and the strings might be relocated. This would be annoying because we have pointers into strings lying around that would need adjusting, and people would add new pointers to the code and forget to adjust them, resulting in intermittent bugs. Putting this call here avoids all that crud. The EQ test avoids infinite recursion. */ if (! NILP (defalt) && !EQ (defalt, name) /* This saves time in a common case. */ && XSTRING (defalt)->data[0] != '/') { struct gcpro gcpro1; GCPRO1 (name); defalt = Fexpand_file_name (defalt, Qnil); UNGCPRO; } #ifdef VMS /* Filenames on VMS are always upper case. */ name = Fupcase (name); #endif #ifdef FILE_SYSTEM_CASE name = FILE_SYSTEM_CASE (name); #endif nm = XSTRING (name)->data; #ifdef MSDOS /* First map all backslashes to slashes. */ dostounix_filename (nm = strcpy (alloca (strlen (nm) + 1), nm)); /* Now strip drive name. */ { unsigned char *colon = rindex (nm, ':'); if (colon) if (nm == colon) nm++; else { drive = tolower (colon[-1]) - 'a'; nm = colon + 1; if (*nm != '/') { defdir = alloca (MAXPATHLEN + 1); relpath = getdefdir (drive + 1, defdir); } } } #endif /* If nm is absolute, flush ...// and detect /./ and /../. If no /./ or /../ we can return right away. */ if ( nm[0] == '/' #ifdef VMS || index (nm, ':') #endif /* VMS */ ) { /* If it turns out that the filename we want to return is just a suffix of FILENAME, we don't need to go through and edit things; we just need to construct a new string using data starting at the middle of FILENAME. If we set lose to a non-zero value, that means we've discovered that we can't do that cool trick. */ int lose = 0; p = nm; while (*p) { /* Since we know the path is absolute, we can assume that each element starts with a "/". */ /* "//" anywhere isn't necessarily hairy; we just start afresh with the second slash. */ if (p[0] == '/' && p[1] == '/' #ifdef APOLLO /* // at start of filename is meaningful on Apollo system */ && nm != p #endif /* APOLLO */ ) nm = p + 1; /* "~" is hairy as the start of any path element. */ if (p[0] == '/' && p[1] == '~') nm = p + 1, lose = 1; /* "." and ".." are hairy. */ if (p[0] == '/' && p[1] == '.' && (p[2] == '/' || p[2] == 0 || (p[2] == '.' && (p[3] == '/' || p[3] == 0)))) lose = 1; #ifdef VMS if (p[0] == '\\') lose = 1; if (p[0] == '/') { /* if dev:[dir]/, move nm to / */ if (!slash && p > nm && (brack || colon)) { nm = (brack ? brack + 1 : colon + 1); lbrack = rbrack = 0; brack = 0; colon = 0; } slash = p; } if (p[0] == '-') #ifndef VMS4_4 /* VMS pre V4.4,convert '-'s in filenames. */ if (lbrack == rbrack) { if (dots < 2) /* this is to allow negative version numbers */ p[0] = '_'; } else #endif /* VMS4_4 */ if (lbrack > rbrack && ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') && (p[1] == '.' || p[1] == ']' || p[1] == '>'))) lose = 1; #ifndef VMS4_4 else p[0] = '_'; #endif /* VMS4_4 */ /* count zeroes, and if already six, check if dot */ /* N.B. this only sets lose = 1 when found [000000.xxx All other valid cases are detected by the ][ detection */ if (zeroes == 6 && p[0] == '.' && p[1] != ']' && p[1] != '>') lose = 1; /* six zeroes found, followed by a dot */ if (zeroes >= 0 && zeroes <= 6 && p[0] == '0') zeroes++; else zeroes = -1; /* count open brackets, reset close bracket pointer */ if (p[0] == '[' || p[0] == '<') lbrack++, brack = 0, lose = (lose || p[0] == '<'), zeroes = 0; /* count close brackets, set close bracket pointer */ if (p[0] == ']' || p[0] == '>') rbrack++, brack = p, lose = (lose || p[0] == '>'); /* detect ][ or >< */ if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<')) lose = 1; if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~') nm = p + 1, lose = 1; if (p[0] == ':' && (colon || slash)) /* if dev1:[dir]dev2:, move nm to dev2: */ if (brack) { nm = brack + 1; brack = 0; colon = 0; /* To prevent dev1:[dir]node:: from becoming [dir]node:: */ } /* if /pathname/dev:, move nm to dev: */ else if (slash) nm = slash + 1; /* if node::dev:, move colon following dev */ else if (colon && colon[-1] == ':') colon = p; /* if dev1:dev2:, move nm to dev2: */ else if (colon && colon[-1] != ':') { nm = colon + 1; colon = 0; } if (p[0] == ':' && !colon) { if (p[1] == ':') p++; colon = p; } if (lbrack == rbrack) if (p[0] == ';') dots = 2; else if (p[0] == '.') dots++; if (p[0] == '.' && p[1] == '.') lose = 1; #endif /* VMS */ p++; } if (!lose) { #ifdef VMS if (index (nm, '/') || strcmp (nm, "..") == 0) return build_string (sys_translate_unix (nm)); #endif /* VMS */ #ifndef MSDOS if (nm == XSTRING (name)->data) return name; return build_string (nm); #endif } } /* Now determine directory to start with and put it in newdir */ newdir = 0; if (nm[0] == '~') /* prefix ~ */ { if (nm[1] == '/' #ifdef VMS || nm[1] == ':' #endif /* VMS */ || nm[1] == 0) /* ~ by itself */ { if (!(newdir = (unsigned char *) egetenv ("HOME"))) newdir = (unsigned char *) ""; #ifdef MSDOS dostounix_filename (newdir); #endif nm++; #ifdef VMS if (*nm != 0) nm++; /* Don't leave the slash in nm. */ #endif /* VMS */ } else /* ~user/filename */ { for (p = nm; *p && (*p != '/' #ifdef VMS && *p != ':' #endif /* VMS */ ); p++); o = (unsigned char *) alloca (p - nm + 1); bcopy ((char *) nm, o, p - nm); o [p - nm] = 0; pw = (struct passwd *) getpwnam (o + 1); if (pw) { newdir = (unsigned char *) pw -> pw_dir; #ifdef VMS nm = p + 1; /* skip the terminator */ #else nm = p; #endif /* VMS */ } /* If we don't find a user of that name, leave the name unchanged; don't move nm forward to p. */ } } if (nm[0] != '/' #ifdef VMS && !index (nm, ':') #endif /* not VMS */ #ifdef MSDOS && drive == -1 #endif && !newdir) { newdir = XSTRING (defalt)->data; } #ifdef MSDOS if (newdir == 0 && relpath) newdir = defdir; #endif if (newdir != 0) { /* Get rid of any slash at the end of newdir. */ int length = strlen (newdir); /* Adding `length > 1 &&' makes ~ expand into / when homedir is the root dir. People disagree about whether that is right. Anyway, we can't take the risk of this change now. */ #ifdef MSDOS if (newdir[1] != ':' && length > 1) #endif if (newdir[length - 1] == '/') { unsigned char *temp = (unsigned char *) alloca (length); bcopy (newdir, temp, length - 1); temp[length - 1] = 0; newdir = temp; } tlen = length + 1; } else tlen = 0; /* Now concatenate the directory and name to new space in the stack frame */ tlen += strlen (nm) + 1; #ifdef VMS tlen += 10; /* VMS might need that extra space in one special case, '[x.-]' ==> '[000000]' */ #endif #ifdef MSDOS /* Add reserved space for drive name. */ target = (unsigned char *) alloca (tlen + 2) + 2; #else target = (unsigned char *) alloca (tlen); #endif *target = 0; if (newdir) { #ifndef VMS if (nm[0] == 0 || nm[0] == '/') strcpy (target, newdir); else #endif file_name_as_directory (target, newdir); } #ifdef VMS if (index (target, '/') || strcmp (target, "..") == 0) strcpy (target, sys_translate_unix (target)); if (index (nm, '/') || strcmp (nm, "..") == 0) strcat (target, sys_translate_unix (nm)); else #endif /* VMS */ strcat (target, nm); /* Now canonicalize by removing /. and /foo/.. if they appear. */ p = target; o = target; #ifdef VMS zeroes = -1; rbrack = 0; /* I reuse rbrack here, to detect the presence of ][ */ #endif /* VMS */ while (*p) { #ifdef VMS if (*p != ']' && *p != '>' && *p != '-') { /* count zeroes, and if already six, check if dot */ if (zeroes == 7) { /* dev:[000000.foo] -> dev:[foo] */ /* however, dev:[000000.000000], dev:[000000.000000.foo], stay as they are */ if (rbrack || strncmp(p, "000000", 6) != 0 || (p[6] != '.' && p[6] != ']' && p[6] != '>')) o -= 7; /* Get rid of 000000. */ zeroes = -1; } else if (zeroes == 6 && p[0] == '.' || zeroes >= 0 && zeroes <= 5 && p[0] == '0') zeroes++; else zeroes = -1; if (zeroes == -1) rbrack = 0; if (*p == '[' || *p == '<') lbrack = 1, zeroes = 0; else lbrack = 0; if (firstbrack >= o) firstbrack = 0; if (firstbrack == 0 && lbrack) firstbrack = o, lbrack = 0; if (*p == '\\') { p++; *o++ = *p++; } else if (*p == '.' && o[-1] == '.') p++; else *o++ = *p++; } else if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<')) { register int tmp_rbrack = 1; { extern int noninteractive; /*if(!noninteractive)lib$signal(SS$_DEBUG); /* TMPTMPTMP */ } p += 2; if (zeroes == -1) zeroes = 0; if (*p != '.' && *p != '-' && o[-1] != '.') { /* convert [foo][bar] to [bar] */ while (o[-1] != '[' && o[-1] != '<') o--; tmp_rbrack = 0; } else if (zeroes == 7) /* convert [000000.][anything] to [anything], convert [foo.][000000.][anything] to [foo.anything] (and then check [anything] for starting [000000 ) */ { if (rbrack) o -= 7, zeroes = 0; else o -= 8, p--, zeroes = -1, tmp_rbrack = 0; } else if (zeroes == 6 && (strncmp(p, ".000000",7) != 0 || rbrack)) /* convert [000000][.foo] to [foo] as long as .foo doesn't start with .000000 */ /* also convert [foo.][000000][.bar] to [foo.bar] */ o -= 6, p++, zeroes = -1; else if (*p == '-' && o[-1] != '.') *o++ = '.', tmp_rbrack = 1, zeroes = -1; rbrack = tmp_rbrack; if (zeroes != -1) zeroes = 0; } else if (p[0] == '-' && o[-1] == '.' && (p[1] == '.' || p[1] == ']' || p[1] == '>')) /* flush .foo.- ; leave - if stopped by '[' or '<' */ { register char *tmp_o = o; zeroes = 0; do { tmp_o--; if (zeroes != -1 && *tmp_o == '0' || zeroes == 0 && *tmp_o == '.') zeroes++; else zeroes = -1; } while (tmp_o[-1] != '.' && tmp_o[-1] != '[' && tmp_o[-1] != '<'); if (zeroes != 7) o = tmp_o, zeroes = -1; else /* [000000.000000.-. */ { char *save_tmp_o = tmp_o; if (tmp_o[-1] != '[' && tmp_o[-1] != '<') do { tmp_o--; if (zeroes != -1 && *tmp_o == '0' || zeroes == 7 && *tmp_o == '.') zeroes++; else zeroes = -1; } while (tmp_o[-1] != '.' && tmp_o[-1] != '[' && tmp_o[-1] != '<' && zeroes != -1); if (zeroes != 7) o = save_tmp_o; if (zeroes == 14 && (tmp_o[-1] == '[' || tmp_o[-1] == '<')) zeroes = 7; else zeroes = -1; } if (o == p) /* '[000000.-' ==> '[000000.-' */ o = ++p, zeroes = -1; else { if (zeroes == -1 && (o[-1] == '[' || o[-1] == '<')) zeroes = 0; if (p[1] == '.') /* foo.-.bar ==> bar*/ p += 2; else if (o[-1] == '.') /* '.foo.-]' ==> ']' */ { if (zeroes != -1) zeroes--; p++, o--; } else /* [foo.-] ==> [000000] */ { p++; if (p - o < 6) memmove (p + 6 - (p - o), p, strlen (p) + 1); else if (p - o > 6) memmove (o + 6, p, strlen (p) + 1); memcpy (o, "000000", 6); o += 6; p = o; zeroes = 6; rbrack = 0; } } } else if (*p == '.' && o[-1] == '.') p++; else { #ifndef VMS4_4 if (*p == '-' && o[-1] != '[' && o[-1] != '<' && o[-1] != '.' && p[1] != ']' && p[1] != '>' && p[1] != '.') *p = '_'; #endif /* VMS4_4 */ if (*p == ']' || *p == '>') { lbrack = 1; /* finally convert [foo.][000000] to [foo] */ if (rbrack && zeroes == 6) { o -= 7; zeroes = -1; } lastbrack = o; } *o++ = *p++; } #else /* not VMS */ if (*p != '/') { *o++ = *p++; } else if (!strncmp (p, "//", 2) #ifdef APOLLO /* // at start of filename is meaningful in Apollo system */ && o != target #endif /* APOLLO */ ) { o = target; p++; } else if (p[0] == '/' && p[1] == '.' && (p[2] == '/' || p[2] == 0)) { /* If "/." is the entire filename, keep the "/". Otherwise, just delete the whole "/.". */ if (o == target && p[2] == '\0') *o++ = *p; p += 2; } else if (!strncmp (p, "/..", 3) /* `/../' is the "superroot" on certain file systems. */ && o != target && (p[3] == '/' || p[3] == 0)) { while (o != target && *--o != '/') ; #ifdef APOLLO if (o == target + 1 && o[-1] == '/' && o[0] == '/') ++o; else #endif /* APOLLO */ if (o == target && *o == '/') ++o; p += 3; } else { *o++ = *p++; } #endif /* not VMS */ } #ifdef MSDOS /* at last, set drive name. */ if (target[1] != ':') { target -= 2; target[0] = (drive < 0 ? getdisk () : drive) + 'a'; target[1] = ':'; } #endif #ifdef VMS if (firstbrack != 0 && lastbrack != 0) { *firstbrack = '['; *lastbrack = ']'; } return Fupcase (make_string (target, o - target)); #endif return make_string (target, o - target); } #if 0 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0, "Convert FILENAME to absolute, and canonicalize it.\n\ Second arg DEFAULT is directory to start with if FILENAME is relative\n\ (does not start with slash); if DEFAULT is nil or missing,\n\ the current buffer's value of default-directory is used.\n\ Filenames containing `.' or `..' as components are simplified;\n\ initial `~/' expands to your home directory.\n\ See also the function `substitute-in-file-name'.") (name, defalt) Lisp_Object name, defalt; { unsigned char *nm; register unsigned char *newdir, *p, *o; int tlen; unsigned char *target; struct passwd *pw; int lose; #ifdef VMS unsigned char * colon = 0; unsigned char * close = 0; unsigned char * slash = 0; unsigned char * brack = 0; int lbrack = 0, rbrack = 0; int dots = 0; #endif /* VMS */ CHECK_STRING (name, 0); #ifdef VMS /* Filenames on VMS are always upper case. */ name = Fupcase (name); #endif nm = XSTRING (name)->data; /* If nm is absolute, flush ...// and detect /./ and /../. If no /./ or /../ we can return right away. */ if ( nm[0] == '/' #ifdef VMS || index (nm, ':') #endif /* VMS */ ) { p = nm; lose = 0; while (*p) { if (p[0] == '/' && p[1] == '/' #ifdef APOLLO /* // at start of filename is meaningful on Apollo system */ && nm != p #endif /* APOLLO */ ) nm = p + 1; if (p[0] == '/' && p[1] == '~') nm = p + 1, lose = 1; if (p[0] == '/' && p[1] == '.' && (p[2] == '/' || p[2] == 0 || (p[2] == '.' && (p[3] == '/' || p[3] == 0)))) lose = 1; #ifdef VMS if (p[0] == '\\') lose = 1; if (p[0] == '/') { /* if dev:[dir]/, move nm to / */ if (!slash && p > nm && (brack || colon)) { nm = (brack ? brack + 1 : colon + 1); lbrack = rbrack = 0; brack = 0; colon = 0; } slash = p; } if (p[0] == '-') #ifndef VMS4_4 /* VMS pre V4.4,convert '-'s in filenames. */ if (lbrack == rbrack) { if (dots < 2) /* this is to allow negative version numbers */ p[0] = '_'; } else #endif /* VMS4_4 */ if (lbrack > rbrack && ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') && (p[1] == '.' || p[1] == ']' || p[1] == '>'))) lose = 1; #ifndef VMS4_4 else p[0] = '_'; #endif /* VMS4_4 */ /* count open brackets, reset close bracket pointer */ if (p[0] == '[' || p[0] == '<') lbrack++, brack = 0; /* count close brackets, set close bracket pointer */ if (p[0] == ']' || p[0] == '>') rbrack++, brack = p; /* detect ][ or >< */ if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<')) lose = 1; if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~') nm = p + 1, lose = 1; if (p[0] == ':' && (colon || slash)) /* if dev1:[dir]dev2:, move nm to dev2: */ if (brack) { nm = brack + 1; brack = 0; } /* if /pathname/dev:, move nm to dev: */ else if (slash) nm = slash + 1; /* if node::dev:, move colon following dev */ else if (colon && colon[-1] == ':') colon = p; /* if dev1:dev2:, move nm to dev2: */ else if (colon && colon[-1] != ':') { nm = colon + 1; colon = 0; } if (p[0] == ':' && !colon) { if (p[1] == ':') p++; colon = p; } if (lbrack == rbrack) if (p[0] == ';') dots = 2; else if (p[0] == '.') dots++; #endif /* VMS */ p++; } if (!lose) { #ifdef VMS if (index (nm, '/') || strcmp (nm, "..") == 0) return build_string (sys_translate_unix (nm)); #endif /* VMS */ if (nm == XSTRING (name)->data) return name; return build_string (nm); } } /* Now determine directory to start with and put it in NEWDIR */ newdir = 0; if (nm[0] == '~') /* prefix ~ */ if (nm[1] == '/' #ifdef VMS || nm[1] == ':' #endif /* VMS */ || nm[1] == 0)/* ~/filename */ { if (!(newdir = (unsigned char *) egetenv ("HOME"))) newdir = (unsigned char *) ""; nm++; #ifdef VMS nm++; /* Don't leave the slash in nm. */ #endif /* VMS */ } else /* ~user/filename */ { /* Get past ~ to user */ unsigned char *user = nm + 1; /* Find end of name. */ unsigned char *ptr = (unsigned char *) index (user, '/'); int len = ptr ? ptr - user : strlen (user); #ifdef VMS unsigned char *ptr1 = index (user, ':'); if (ptr1 != 0 && ptr1 - user < len) len = ptr1 - user; #endif /* VMS */ /* Copy the user name into temp storage. */ o = (unsigned char *) alloca (len + 1); bcopy ((char *) user, o, len); o[len] = 0; /* Look up the user name. */ pw = (struct passwd *) getpwnam (o + 1); if (!pw) error ("\"%s\" isn't a registered user", o + 1); newdir = (unsigned char *) pw->pw_dir; /* Discard the user name from NM. */ nm += len; } if (nm[0] != '/' #ifdef VMS && !index (nm, ':') #endif /* not VMS */ && !newdir) { if (NILP (defalt)) defalt = current_buffer->directory; CHECK_STRING (defalt, 1); newdir = XSTRING (defalt)->data; } /* Now concatenate the directory and name to new space in the stack frame */ tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1; target = (unsigned char *) alloca (tlen); *target = 0; if (newdir) { #ifndef VMS if (nm[0] == 0 || nm[0] == '/') strcpy (target, newdir); else #endif file_name_as_directory (target, newdir); } strcat (target, nm); #ifdef VMS if (index (target, '/') || strcmp (target, "..") == 0) strcpy (target, sys_translate_unix (target)); #endif /* VMS */ /* Now canonicalize by removing /. and /foo/.. if they appear */ p = target; o = target; while (*p) { #ifdef VMS if (*p != ']' && *p != '>' && *p != '-') { if (*p == '\\') p++; *o++ = *p++; } else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2) /* brackets are offset from each other by 2 */ { p += 2; if (*p != '.' && *p != '-' && o[-1] != '.') /* convert [foo][bar] to [bar] */ while (o[-1] != '[' && o[-1] != '<') o--; else if (*p == '-' && *o != '.') *--p = '.'; } else if (p[0] == '-' && o[-1] == '.' && (p[1] == '.' || p[1] == ']' || p[1] == '>')) /* flush .foo.- ; leave - if stopped by '[' or '<' */ { do o--; while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<'); if (p[1] == '.') /* foo.-.bar ==> bar*/ p += 2; else if (o[-1] == '.') /* '.foo.-]' ==> ']' */ p++, o--; /* else [foo.-] ==> [-] */ } else { #ifndef VMS4_4 if (*p == '-' && o[-1] != '[' && o[-1] != '<' && o[-1] != '.' && p[1] != ']' && p[1] != '>' && p[1] != '.') *p = '_'; #endif /* VMS4_4 */ *o++ = *p++; } #else /* not VMS */ if (*p != '/') { *o++ = *p++; } else if (!strncmp (p, "//", 2) #ifdef APOLLO /* // at start of filename is meaningful in Apollo system */ && o != target #endif /* APOLLO */ ) { o = target; p++; } else if (p[0] == '/' && p[1] == '.' && (p[2] == '/' || p[2] == 0)) p += 2; else if (!strncmp (p, "/..", 3) /* `/../' is the "superroot" on certain file systems. */ && o != target && (p[3] == '/' || p[3] == 0)) { while (o != target && *--o != '/') ; #ifdef APOLLO if (o == target + 1 && o[-1] == '/' && o[0] == '/') ++o; else #endif /* APOLLO */ if (o == target && *o == '/') ++o; p += 3; } else { *o++ = *p++; } #endif /* not VMS */ } #ifdef VMS if (firstbrack != 0 && lastbrack != 0) { *firstbrack = '['; *lastbrack = ']'; } #endif return Fupcase (make_string (target, o - target)); } #endif DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, Ssubstitute_in_file_name, 1, 1, 0, "Substitute environment variables referred to in FILENAME.\n\ `$FOO' where FOO is an environment variable name means to substitute\n\ the value of that variable. The variable name should be terminated\n\ with a character not a letter, digit or underscore; otherwise, enclose\n\ the entire variable name in braces.\n\ If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\ On VMS, `$' substitution is not done; this function does little and only\n\ duplicates what `expand-file-name' does.") (string) Lisp_Object string; { unsigned char *nm; register unsigned char *s, *p, *o, *x, *endp; unsigned char *target; int total = 0; int substituted = 0; unsigned char *xnm; CHECK_STRING (string, 0); nm = XSTRING (string)->data; #ifdef MSDOS dostounix_filename (nm = strcpy (alloca (strlen (nm) + 1), nm)); substituted = !strcmp (nm, XSTRING (string)->data); #endif endp = nm + XSTRING (string)->size; /* If /~ or // appears, discard everything through first slash. */ for (p = nm; p != endp; p++) { if ((p[0] == '~' || #ifdef APOLLO /* // at start of file name is meaningful in Apollo system */ (p[0] == '/' && p - 1 != nm) #else /* not APOLLO */ p[0] == '/' #endif /* not APOLLO */ ) && p != nm && #ifdef VMS (p[-1] == ':' || p[-1] == ']' || p[-1] == '>' || #endif /* VMS */ p[-1] == '/') #ifdef VMS ) #endif /* VMS */ { nm = p; substituted = 1; } #ifdef MSDOS if (p[0] && p[1] == ':') { nm = p; substituted = 1; } #endif /* MSDOS */ } #ifdef VMS return build_string (nm); #else /* See if any variables are substituted into the string and find the total length of their values in `total' */ for (p = nm; p != endp;) if (*p != '$') p++; else { p++; if (p == endp) goto badsubst; else if (*p == '$') { /* "$$" means a single "$" */ p++; total -= 1; substituted = 1; continue; } else if (*p == '{') { o = ++p; while (p != endp && *p != '}') p++; if (*p != '}') goto missingclose; s = p; } else { o = p; while (p != endp && (isalnum (*p) || *p == '_')) p++; s = p; } /* Copy out the variable name */ target = (unsigned char *) alloca (s - o + 1); strncpy (target, o, s - o); target[s - o] = 0; #ifdef MSDOS strupr (target); /* $home == $HOME etc. */ #endif /* Get variable value */ o = (unsigned char *) egetenv (target); if (!o) goto badvar; total += strlen (o); substituted = 1; } if (!substituted) return string; /* If substitution required, recopy the string and do it */ /* Make space in stack frame for the new copy */ xnm = (unsigned char *) alloca (XSTRING (string)->size + total + 1); x = xnm; /* Copy the rest of the name through, replacing $ constructs with values */ for (p = nm; *p;) if (*p != '$') *x++ = *p++; else { p++; if (p == endp) goto badsubst; else if (*p == '$') { *x++ = *p++; continue; } else if (*p == '{') { o = ++p; while (p != endp && *p != '}') p++; if (*p != '}') goto missingclose; s = p++; } else { o = p; while (p != endp && (isalnum (*p) || *p == '_')) p++; s = p; } /* Copy out the variable name */ target = (unsigned char *) alloca (s - o + 1); strncpy (target, o, s - o); target[s - o] = 0; #ifdef MSDOS strupr (target); /* $home == $HOME etc. */ #endif /* Get variable value */ o = (unsigned char *) egetenv (target); if (!o) goto badvar; strcpy (x, o); x += strlen (o); } *x = 0; /* If /~ or // appears, discard everything through first slash. */ for (p = xnm; p != x; p++) if ((p[0] == '~' || #ifdef APOLLO /* // at start of file name is meaningful in Apollo system */ (p[0] == '/' && p - 1 != xnm) #else /* not APOLLO */ p[0] == '/' #endif /* not APOLLO */ ) && p != nm && p[-1] == '/') xnm = p; #ifdef MSDOS else if (p[0] && p[1] == ':') xnm = p; #endif return make_string (xnm, x - xnm); badsubst: error ("Bad format environment-variable substitution"); missingclose: error ("Missing \"}\" in environment-variable substitution"); badvar: error ("Substituting nonexistent environment variable \"%s\"", target); /* NOTREACHED */ #endif /* not VMS */ } /* A slightly faster and more convenient way to get (directory-file-name (expand-file-name FOO)). */ Lisp_Object expand_and_dir_to_file (filename, defdir) Lisp_Object filename, defdir; { register Lisp_Object abspath; abspath = Fexpand_file_name (filename, defdir); #ifdef VMS { register int c = XSTRING (abspath)->data[XSTRING (abspath)->size - 1]; if (c == ':' || c == ']' || c == '>') abspath = Fdirectory_file_name (abspath); } #else /* Remove final slash, if any (unless path is root). stat behaves differently depending! */ if (XSTRING (abspath)->size > 1 && XSTRING (abspath)->data[XSTRING (abspath)->size - 1] == '/') /* We cannot take shortcuts; they might be wrong for magic file names. */ abspath = Fdirectory_file_name (abspath); #endif return abspath; } barf_or_query_if_file_exists (absname, querystring, interactive) Lisp_Object absname; unsigned char *querystring; int interactive; { register Lisp_Object tem; struct stat statbuf; struct gcpro gcpro1; /* stat is a good way to tell whether the file exists, regardless of what access permissions it has. */ if (stat (XSTRING (absname)->data, &statbuf) >= 0) { if (! interactive) Fsignal (Qfile_already_exists, Fcons (build_string ("File already exists"), Fcons (absname, Qnil))); GCPRO1 (absname); tem = do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ", XSTRING (absname)->data, querystring)); UNGCPRO; if (NILP (tem)) Fsignal (Qfile_already_exists, Fcons (build_string ("File already exists"), Fcons (absname, Qnil))); } return; } DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 4, "fCopy file: \nFCopy %s to file: \np\nP", "Copy FILE to NEWNAME. Both args must be strings.\n\ Signals a `file-already-exists' error if file NEWNAME already exists,\n\ unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\ A number as third arg means request confirmation if NEWNAME already exists.\n\ This is what happens in interactive use with M-x.\n\ Fourth arg KEEP-TIME non-nil means give the new file the same\n\ last-modified time as the old one. (This works on only some systems.)\n\ A prefix arg makes KEEP-TIME non-nil.") (filename, newname, ok_if_already_exists, keep_date) Lisp_Object filename, newname, ok_if_already_exists, keep_date; { int ifd, ofd, n; char buf[16 * 1024]; struct stat st; Lisp_Object handler; struct gcpro gcpro1, gcpro2; int count = specpdl_ptr - specpdl; int input_file_statable_p; GCPRO2 (filename, newname); CHECK_STRING (filename, 0); CHECK_STRING (newname, 1); filename = Fexpand_file_name (filename, Qnil); newname = Fexpand_file_name (newname, Qnil); /* If the input file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qcopy_file); /* Likewise for output file name. */ if (NILP (handler)) handler = Ffind_file_name_handler (newname, Qcopy_file); if (!NILP (handler)) RETURN_UNGCPRO (call5 (handler, Qcopy_file, filename, newname, ok_if_already_exists, keep_date)); if (NILP (ok_if_already_exists) || XTYPE (ok_if_already_exists) == Lisp_Int) barf_or_query_if_file_exists (newname, "copy to it", XTYPE (ok_if_already_exists) == Lisp_Int); ifd = open (XSTRING (filename)->data, O_RDONLY); if (ifd < 0) report_file_error ("Opening input file", Fcons (filename, Qnil)); record_unwind_protect (close_file_unwind, make_number (ifd)); /* We can only copy regular files and symbolic links. Other files are not copyable by us. */ input_file_statable_p = (fstat (ifd, &st) >= 0); #if defined (S_ISREG) && defined (S_ISLNK) if (input_file_statable_p) { if (!(S_ISREG (st.st_mode)) && !(S_ISLNK (st.st_mode))) { #if defined (EISDIR) /* Get a better looking error message. */ errno = EISDIR; #endif /* EISDIR */ report_file_error ("Non-regular file", Fcons (filename, Qnil)); } } #endif /* S_ISREG && S_ISLNK */ #ifdef VMS /* Create the copy file with the same record format as the input file */ ofd = sys_creat (XSTRING (newname)->data, 0666, ifd); #else #ifdef MSDOS /* System's default file type was set to binary by _fmode in emacs.c. */ ofd = creat (XSTRING (newname)->data, S_IREAD | S_IWRITE); #else /* not MSDOS */ ofd = creat (XSTRING (newname)->data, 0666); #endif /* not MSDOS */ #endif /* VMS */ if (ofd < 0) report_file_error ("Opening output file", Fcons (newname, Qnil)); record_unwind_protect (close_file_unwind, make_number (ofd)); immediate_quit = 1; QUIT; while ((n = read (ifd, buf, sizeof buf)) > 0) if (write (ofd, buf, n) != n) report_file_error ("I/O error", Fcons (newname, Qnil)); immediate_quit = 0; /* Closing the output clobbers the file times on some systems. */ if (close (ofd) < 0) report_file_error ("I/O error", Fcons (newname, Qnil)); if (input_file_statable_p) { #ifndef VMS /* On VMS, chmod changes the modification time, whic is quite stupid, so we have to put the VMS code after the chmod... */ if (!NILP (keep_date)) { EMACS_TIME atime, mtime; EMACS_SET_SECS_USECS (atime, st.st_atime, 0); EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0); EMACS_SET_UTIMES (XSTRING (newname)->data, atime, mtime); } #endif /* not VMS */ #ifdef APOLLO if (!egetenv ("USE_DOMAIN_ACLS")) #endif chmod (XSTRING (newname)->data, st.st_mode & 07777); #ifdef VMS /* ... so here it is. */ if (!NILP (keep_date)) { EMACS_TIME atime, mtime; EMACS_SET_SECS_USECS (atime, st.st_atime, 0); EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0); EMACS_SET_UTIMES (XSTRING (newname)->data, atime, mtime); } #endif /* VMS */ } close (ifd); /* Discard the unwind protects. */ specpdl_ptr = specpdl + count; UNGCPRO; return Qnil; } DEFUN ("make-directory-internal", Fmake_directory_internal, Smake_directory_internal, 1, 1, 0, "Create a directory. One argument, a file name string.") (dirname) Lisp_Object dirname; { unsigned char *dir; Lisp_Object handler; CHECK_STRING (dirname, 0); dirname = Fexpand_file_name (dirname, Qnil); handler = Ffind_file_name_handler (dirname, Qmake_directory_internal); if (!NILP (handler)) return call2 (handler, Qmake_directory_internal, dirname); dir = XSTRING (dirname)->data; if (mkdir (dir, 0777) != 0) report_file_error ("Creating directory", Flist (1, &dirname)); return Qnil; } DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ", "Delete a directory. One argument, a file name or directory name string.") (dirname) Lisp_Object dirname; { unsigned char *dir; Lisp_Object handler; CHECK_STRING (dirname, 0); dirname = Fdirectory_file_name (Fexpand_file_name (dirname, Qnil)); dir = XSTRING (dirname)->data; handler = Ffind_file_name_handler (dirname, Qdelete_directory); if (!NILP (handler)) return call2 (handler, Qdelete_directory, dirname); #ifdef VMS dirname = Fdirectory_file_name(dirname); dir = XSTRING (dirname)->data; chmod (dir, 0755); /* Otherwise, VMS won't let me delete it! */ if (remove (dir) != 0) report_file_error ("Removing directory", Flist (1, &dirname)); #else if (rmdir (dir) != 0) report_file_error ("Removing directory", Flist (1, &dirname)); #endif return Qnil; } DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ", "Delete specified file. One argument, a file name string.\n\ If file has multiple names, it continues to exist with the other names.") (filename) Lisp_Object filename; { Lisp_Object handler; CHECK_STRING (filename, 0); filename = Fexpand_file_name (filename, Qnil); handler = Ffind_file_name_handler (filename, Qdelete_file); if (!NILP (handler)) return call2 (handler, Qdelete_file, filename); if (0 > unlink (XSTRING (filename)->data)) report_file_error ("Removing old name", Flist (1, &filename)); return Qnil; } DEFUN ("rename-file", Frename_file, Srename_file, 2, 3, "fRename file: \nFRename %s to file: \np", "Rename FILE as NEWNAME. Both args strings.\n\ If file has names other than FILE, it continues to have those names.\n\ Signals a `file-already-exists' error if a file NEWNAME already exists\n\ unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\ A number as third arg means request confirmation if NEWNAME already exists.\n\ This is what happens in interactive use with M-x.") (filename, newname, ok_if_already_exists) Lisp_Object filename, newname, ok_if_already_exists; { #ifdef NO_ARG_ARRAY Lisp_Object args[2]; #endif Lisp_Object handler; struct gcpro gcpro1, gcpro2; GCPRO2 (filename, newname); CHECK_STRING (filename, 0); CHECK_STRING (newname, 1); filename = Fexpand_file_name (filename, Qnil); newname = Fexpand_file_name (newname, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qrename_file); if (NILP (handler)) handler = Ffind_file_name_handler (newname, Qrename_file); if (!NILP (handler)) RETURN_UNGCPRO (call4 (handler, Qrename_file, filename, newname, ok_if_already_exists)); if (NILP (ok_if_already_exists) || XTYPE (ok_if_already_exists) == Lisp_Int) barf_or_query_if_file_exists (newname, "rename to it", XTYPE (ok_if_already_exists) == Lisp_Int); #ifndef BSD4_1 if (0 > rename (XSTRING (filename)->data, XSTRING (newname)->data)) #else if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data) || 0 > unlink (XSTRING (filename)->data)) #endif { if (errno == EXDEV) { Fcopy_file (filename, newname, /* We have already prompted if it was an integer, so don't have copy-file prompt again. */ NILP (ok_if_already_exists) ? Qnil : Qt, Qt); Fdelete_file (filename); } else #ifdef NO_ARG_ARRAY { args[0] = filename; args[1] = newname; report_file_error ("Renaming", Flist (2, args)); } #else report_file_error ("Renaming", Flist (2, &filename)); #endif } UNGCPRO; return Qnil; } DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3, "fAdd name to file: \nFName to add to %s: \np", "Give FILE additional name NEWNAME. Both args strings.\n\ Signals a `file-already-exists' error if a file NEWNAME already exists\n\ unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\ A number as third arg means request confirmation if NEWNAME already exists.\n\ This is what happens in interactive use with M-x.") (filename, newname, ok_if_already_exists) Lisp_Object filename, newname, ok_if_already_exists; { #ifdef NO_ARG_ARRAY Lisp_Object args[2]; #endif Lisp_Object handler; struct gcpro gcpro1, gcpro2; GCPRO2 (filename, newname); CHECK_STRING (filename, 0); CHECK_STRING (newname, 1); filename = Fexpand_file_name (filename, Qnil); newname = Fexpand_file_name (newname, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qadd_name_to_file); if (!NILP (handler)) RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename, newname, ok_if_already_exists)); if (NILP (ok_if_already_exists) || XTYPE (ok_if_already_exists) == Lisp_Int) barf_or_query_if_file_exists (newname, "make it a new name", XTYPE (ok_if_already_exists) == Lisp_Int); unlink (XSTRING (newname)->data); if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data)) { #ifdef NO_ARG_ARRAY args[0] = filename; args[1] = newname; report_file_error ("Adding new name", Flist (2, args)); #else report_file_error ("Adding new name", Flist (2, &filename)); #endif } UNGCPRO; return Qnil; } #ifdef S_IFLNK DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3, "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\ Signals a `file-already-exists' error if a file NEWNAME already exists\n\ unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\ A number as third arg means request confirmation if NEWNAME already exists.\n\ This happens for interactive use with M-x.") (filename, linkname, ok_if_already_exists) Lisp_Object filename, linkname, ok_if_already_exists; { #ifdef NO_ARG_ARRAY Lisp_Object args[2]; #endif Lisp_Object handler; struct gcpro gcpro1, gcpro2; GCPRO2 (filename, linkname); CHECK_STRING (filename, 0); CHECK_STRING (linkname, 1); /* If the link target has a ~, we must expand it to get a truly valid file name. Otherwise, do not expand; we want to permit links to relative file names. */ if (XSTRING (filename)->data[0] == '~') filename = Fexpand_file_name (filename, Qnil); linkname = Fexpand_file_name (linkname, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qmake_symbolic_link); if (!NILP (handler)) RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, linkname, ok_if_already_exists)); if (NILP (ok_if_already_exists) || XTYPE (ok_if_already_exists) == Lisp_Int) barf_or_query_if_file_exists (linkname, "make it a link", XTYPE (ok_if_already_exists) == Lisp_Int); if (0 > symlink (XSTRING (filename)->data, XSTRING (linkname)->data)) { /* If we didn't complain already, silently delete existing file. */ if (errno == EEXIST) { unlink (XSTRING (linkname)->data); if (0 <= symlink (XSTRING (filename)->data, XSTRING (linkname)->data)) { UNGCPRO; return Qnil; } } #ifdef NO_ARG_ARRAY args[0] = filename; args[1] = linkname; report_file_error ("Making symbolic link", Flist (2, args)); #else report_file_error ("Making symbolic link", Flist (2, &filename)); #endif } UNGCPRO; return Qnil; } #endif /* S_IFLNK */ #ifdef VMS DEFUN ("define-logical-name", Fdefine_logical_name, Sdefine_logical_name, 2, 2, "sDefine logical name: \nsDefine logical name %s as: ", "Define the job-wide logical name NAME to have the value STRING.\n\ If STRING is nil or a null string, the logical name NAME is deleted.") (varname, string) Lisp_Object varname; Lisp_Object string; { CHECK_STRING (varname, 0); if (NILP (string)) delete_logical_name (XSTRING (varname)->data); else { CHECK_STRING (string, 1); if (XSTRING (string)->size == 0) delete_logical_name (XSTRING (varname)->data); else define_logical_name (XSTRING (varname)->data, XSTRING (string)->data); } return string; } #endif /* VMS */ #ifdef HPUX_NET DEFUN ("sysnetunam", Fsysnetunam, Ssysnetunam, 2, 2, 0, "Open a network connection to PATH using LOGIN as the login string.") (path, login) Lisp_Object path, login; { int netresult; CHECK_STRING (path, 0); CHECK_STRING (login, 0); netresult = netunam (XSTRING (path)->data, XSTRING (login)->data); if (netresult == -1) return Qnil; else return Qt; } #endif /* HPUX_NET */ DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p, 1, 1, 0, "Return t if file FILENAME specifies an absolute path name.\n\ On Unix, this is a name starting with a `/' or a `~'.") (filename) Lisp_Object filename; { unsigned char *ptr; CHECK_STRING (filename, 0); ptr = XSTRING (filename)->data; if (*ptr == '/' || *ptr == '~' #ifdef VMS /* ??? This criterion is probably wrong for '<'. */ || index (ptr, ':') || index (ptr, '<') || (*ptr == '[' && (ptr[1] != '-' || (ptr[2] != '.' && ptr[2] != ']')) && ptr[1] != '.') #endif /* VMS */ #ifdef MSDOS || (*ptr != 0 && ptr[1] == ':' && (ptr[2] == '/' || ptr[2] == '\\')) #endif ) return Qt; else return Qnil; } DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0, "Return t if file FILENAME exists. (This does not mean you can read it.)\n\ See also `file-readable-p' and `file-attributes'.") (filename) Lisp_Object filename; { Lisp_Object abspath; Lisp_Object handler; struct stat statbuf; CHECK_STRING (filename, 0); abspath = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (abspath, Qfile_exists_p); if (!NILP (handler)) return call2 (handler, Qfile_exists_p, abspath); return (stat (XSTRING (abspath)->data, &statbuf) >= 0) ? Qt : Qnil; } DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0, "Return t if FILENAME can be executed by you.\n\ For a directory, this means you can access files in that directory.") (filename) Lisp_Object filename; { Lisp_Object abspath; Lisp_Object handler; CHECK_STRING (filename, 0); abspath = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (abspath, Qfile_executable_p); if (!NILP (handler)) return call2 (handler, Qfile_executable_p, abspath); return (access (XSTRING (abspath)->data, 1) >= 0) ? Qt : Qnil; } DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0, "Return t if file FILENAME exists and you can read it.\n\ See also `file-exists-p' and `file-attributes'.") (filename) Lisp_Object filename; { Lisp_Object abspath; Lisp_Object handler; int desc; CHECK_STRING (filename, 0); abspath = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (abspath, Qfile_readable_p); if (!NILP (handler)) return call2 (handler, Qfile_readable_p, abspath); desc = open (XSTRING (abspath)->data, O_RDONLY); if (desc < 0) return Qnil; close (desc); return Qt; } DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0, "Return non-nil if file FILENAME is the name of a symbolic link.\n\ The value is the name of the file to which it is linked.\n\ Otherwise returns nil.") (filename) Lisp_Object filename; { #ifdef S_IFLNK char *buf; int bufsize; int valsize; Lisp_Object val; Lisp_Object handler; CHECK_STRING (filename, 0); filename = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qfile_symlink_p); if (!NILP (handler)) return call2 (handler, Qfile_symlink_p, filename); bufsize = 100; while (1) { buf = (char *) xmalloc (bufsize); bzero (buf, bufsize); valsize = readlink (XSTRING (filename)->data, buf, bufsize); if (valsize < bufsize) break; /* Buffer was not long enough */ xfree (buf); bufsize *= 2; } if (valsize == -1) { xfree (buf); return Qnil; } val = make_string (buf, valsize); xfree (buf); return val; #else /* not S_IFLNK */ return Qnil; #endif /* not S_IFLNK */ } #ifdef SOLARIS_BROKEN_ACCESS /* In Solaris 2.1, the readonly-ness of the filesystem is not considered by the access system call. This is Sun's bug, but we still have to make Emacs work. */ #include static int ro_fsys (path) char *path; { struct statvfs statvfsb; if (statvfs(path, &statvfsb)) return 1; /* error from statvfs, be conservative and say not wrtable */ else /* Otherwise, fsys is ro if bit is set. */ return statvfsb.f_flag & ST_RDONLY; } #else /* But on every other os, access has already done the right thing. */ #define ro_fsys(path) 0 #endif /* Having this before file-symlink-p mysteriously caused it to be forgotten on the RT/PC. */ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, "Return t if file FILENAME can be written or created by you.") (filename) Lisp_Object filename; { Lisp_Object abspath, dir; Lisp_Object handler; CHECK_STRING (filename, 0); abspath = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (abspath, Qfile_writable_p); if (!NILP (handler)) return call2 (handler, Qfile_writable_p, abspath); if (access (XSTRING (abspath)->data, 0) >= 0) return ((access (XSTRING (abspath)->data, 2) >= 0 && ! ro_fsys ((char *) XSTRING (abspath)->data)) ? Qt : Qnil); dir = Ffile_name_directory (abspath); #ifdef VMS if (!NILP (dir)) dir = Fdirectory_file_name (dir); #endif /* VMS */ #ifdef MSDOS if (!NILP (dir)) dir = Fdirectory_file_name (dir); #endif /* MSDOS */ return ((access (!NILP (dir) ? (char *) XSTRING (dir)->data : "", 2) >= 0 && ! ro_fsys ((char *) XSTRING (dir)->data)) ? Qt : Qnil); } DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0, "Return t if file FILENAME is the name of a directory as a file.\n\ A directory name spec may be given instead; then the value is t\n\ if the directory so specified exists and really is a directory.") (filename) Lisp_Object filename; { register Lisp_Object abspath; struct stat st; Lisp_Object handler; abspath = expand_and_dir_to_file (filename, current_buffer->directory); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (abspath, Qfile_directory_p); if (!NILP (handler)) return call2 (handler, Qfile_directory_p, abspath); if (stat (XSTRING (abspath)->data, &st) < 0) return Qnil; return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil; } DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, Sfile_accessible_directory_p, 1, 1, 0, "Return t if file FILENAME is the name of a directory as a file,\n\ and files in that directory can be opened by you. In order to use a\n\ directory as a buffer's current directory, this predicate must return true.\n\ A directory name spec may be given instead; then the value is t\n\ if the directory so specified exists and really is a readable and\n\ searchable directory.") (filename) Lisp_Object filename; { Lisp_Object handler; int tem; struct gcpro gcpro1; /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p); if (!NILP (handler)) return call2 (handler, Qfile_accessible_directory_p, filename); /* It's an unlikely combination, but yes we really do need to gcpro: Suppose that file-accessible-directory-p has no handler, but file-directory-p does have a handler; this handler causes a GC which relocates the string in `filename'; and finally file-directory-p returns non-nil. Then we would end up passing a garbaged string to file-executable-p. */ GCPRO1 (filename); tem = (NILP (Ffile_directory_p (filename)) || NILP (Ffile_executable_p (filename))); UNGCPRO; return tem ? Qnil : Qt; } DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0, "Return mode bits of FILE, as an integer.") (filename) Lisp_Object filename; { Lisp_Object abspath; struct stat st; Lisp_Object handler; abspath = expand_and_dir_to_file (filename, current_buffer->directory); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (abspath, Qfile_modes); if (!NILP (handler)) return call2 (handler, Qfile_modes, abspath); if (stat (XSTRING (abspath)->data, &st) < 0) return Qnil; #ifdef MSDOS { int len; char *suffix; if (S_ISREG (st.st_mode) && (len = XSTRING (abspath)->size) >= 5 && (stricmp ((suffix = XSTRING (abspath)->data + len-4), ".com") == 0 || stricmp (suffix, ".exe") == 0 || stricmp (suffix, ".bat") == 0)) st.st_mode |= S_IEXEC; } #endif /* MSDOS */ return make_number (st.st_mode & 07777); } DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2, 0, "Set mode bits of FILE to MODE (an integer).\n\ Only the 12 low bits of MODE are used.") (filename, mode) Lisp_Object filename, mode; { Lisp_Object abspath; Lisp_Object handler; abspath = Fexpand_file_name (filename, current_buffer->directory); CHECK_NUMBER (mode, 1); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (abspath, Qset_file_modes); if (!NILP (handler)) return call3 (handler, Qset_file_modes, abspath, mode); #ifndef APOLLO if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0) report_file_error ("Doing chmod", Fcons (abspath, Qnil)); #else /* APOLLO */ if (!egetenv ("USE_DOMAIN_ACLS")) { struct stat st; struct timeval tvp[2]; /* chmod on apollo also change the file's modtime; need to save the modtime and then restore it. */ if (stat (XSTRING (abspath)->data, &st) < 0) { report_file_error ("Doing chmod", Fcons (abspath, Qnil)); return (Qnil); } if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0) report_file_error ("Doing chmod", Fcons (abspath, Qnil)); /* reset the old accessed and modified times. */ tvp[0].tv_sec = st.st_atime + 1; /* +1 due to an Apollo roundoff bug */ tvp[0].tv_usec = 0; tvp[1].tv_sec = st.st_mtime + 1; /* +1 due to an Apollo roundoff bug */ tvp[1].tv_usec = 0; if (utimes (XSTRING (abspath)->data, tvp) < 0) report_file_error ("Doing utimes", Fcons (abspath, Qnil)); } #endif /* APOLLO */ return Qnil; } DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_modes, 1, 1, 0, "Set the file permission bits for newly created files.\n\ The argument MODE should be an integer; only the low 9 bits are used.\n\ This setting is inherited by subprocesses.") (mode) Lisp_Object mode; { CHECK_NUMBER (mode, 0); umask ((~ XINT (mode)) & 0777); return Qnil; } DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0, "Return the default file protection for created files.\n\ The value is an integer.") () { int realmask; Lisp_Object value; realmask = umask (0); umask (realmask); XSET (value, Lisp_Int, (~ realmask) & 0777); return value; } #ifdef unix DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "", "Tell Unix to finish all pending disk updates.") () { sync (); return Qnil; } #endif /* unix */ DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0, "Return t if file FILE1 is newer than file FILE2.\n\ If FILE1 does not exist, the answer is nil;\n\ otherwise, if FILE2 does not exist, the answer is t.") (file1, file2) Lisp_Object file1, file2; { Lisp_Object abspath1, abspath2; struct stat st; int mtime1; Lisp_Object handler; struct gcpro gcpro1, gcpro2; CHECK_STRING (file1, 0); CHECK_STRING (file2, 0); abspath1 = Qnil; GCPRO2 (abspath1, file2); abspath1 = expand_and_dir_to_file (file1, current_buffer->directory); abspath2 = expand_and_dir_to_file (file2, current_buffer->directory); UNGCPRO; /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p); if (NILP (handler)) handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p); if (!NILP (handler)) return call3 (handler, Qfile_newer_than_file_p, abspath1, abspath2); if (stat (XSTRING (abspath1)->data, &st) < 0) return Qnil; mtime1 = st.st_mtime; if (stat (XSTRING (abspath2)->data, &st) < 0) return Qt; return (mtime1 > st.st_mtime) ? Qt : Qnil; } #ifdef MSDOS Lisp_Object Qfind_buffer_file_type; #endif DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents, 1, 5, 0, "Insert contents of file FILENAME after point.\n\ Returns list of absolute file name and length of data inserted.\n\ If second argument VISIT is non-nil, the buffer's visited filename\n\ and last save file modtime are set, and it is marked unmodified.\n\ If visiting and the file does not exist, visiting is completed\n\ before the error is signaled.\n\n\ The optional third and fourth arguments BEG and END\n\ specify what portion of the file to insert.\n\ If VISIT is non-nil, BEG and END must be nil.\n\ If optional fifth argument REPLACE is non-nil,\n\ it means replace the current buffer contents (in the accessible portion)\n\ with the file contents. This is better than simply deleting and inserting\n\ the whole thing because (1) it preserves some marker positions\n\ and (2) it puts less data in the undo list.") (filename, visit, beg, end, replace) Lisp_Object filename, visit, beg, end, replace; { struct stat st; register int fd; register int inserted = 0; register int how_much; int count = specpdl_ptr - specpdl; struct gcpro gcpro1, gcpro2, gcpro3; Lisp_Object handler, val, insval; Lisp_Object p; int total; val = Qnil; p = Qnil; GCPRO3 (filename, val, p); if (!NILP (current_buffer->read_only)) Fbarf_if_buffer_read_only(); CHECK_STRING (filename, 0); filename = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qinsert_file_contents); if (!NILP (handler)) { val = call6 (handler, Qinsert_file_contents, filename, visit, beg, end, replace); goto handled; } fd = -1; #ifndef APOLLO if (stat (XSTRING (filename)->data, &st) < 0) #else if ((fd = open (XSTRING (filename)->data, O_RDONLY)) < 0 || fstat (fd, &st) < 0) #endif /* not APOLLO */ { if (fd >= 0) close (fd); badopen: if (NILP (visit)) report_file_error ("Opening input file", Fcons (filename, Qnil)); st.st_mtime = -1; how_much = 0; goto notfound; } #ifdef S_IFREG /* This code will need to be changed in order to work on named pipes, and it's probably just not worth it. So we should at least signal an error. */ if (!S_ISREG (st.st_mode)) Fsignal (Qfile_error, Fcons (build_string ("not a regular file"), Fcons (filename, Qnil))); #endif if (fd < 0) if ((fd = open (XSTRING (filename)->data, O_RDONLY)) < 0) goto badopen; /* Replacement should preserve point as it preserves markers. */ if (!NILP (replace)) record_unwind_protect (restore_point_unwind, Fpoint_marker ()); record_unwind_protect (close_file_unwind, make_number (fd)); /* Supposedly happens on VMS. */ if (st.st_size < 0) error ("File size is negative"); if (!NILP (beg) || !NILP (end)) if (!NILP (visit)) error ("Attempt to visit less than an entire file"); if (!NILP (beg)) CHECK_NUMBER (beg, 0); else XFASTINT (beg) = 0; if (!NILP (end)) CHECK_NUMBER (end, 0); else { XSETINT (end, st.st_size); if (XINT (end) != st.st_size) error ("maximum buffer size exceeded"); } /* If requested, replace the accessible part of the buffer with the file contents. Avoid replacing text at the beginning or end of the buffer that matches the file contents; that preserves markers pointing to the unchanged parts. */ #if defined(MSDOS) || defined(VMS) /* On MSDOS, replace mode doesn't really work, except for binary files, and it's not worth supporting just for them. */ if (!NILP (replace)) { replace = Qnil; XFASTINT (beg) = 0; XFASTINT (end) = st.st_size; del_range_1 (BEGV, ZV, 0); } #else /* MSDOS */ if (!NILP (replace)) { unsigned char buffer[1 << 14]; int same_at_start = BEGV; int same_at_end = ZV; int overlap; immediate_quit = 1; QUIT; /* Count how many chars at the start of the file match the text at the beginning of the buffer. */ while (1) { int nread, bufpos; nread = read (fd, buffer, sizeof buffer); if (nread < 0) error ("IO error reading %s: %s", XSTRING (filename)->data, err_str (errno)); else if (nread == 0) break; bufpos = 0; while (bufpos < nread && same_at_start < ZV && FETCH_CHAR (same_at_start) == buffer[bufpos]) same_at_start++, bufpos++; /* If we found a discrepancy, stop the scan. Otherwise loop around and scan the next bufferfull. */ if (bufpos != nread) break; } immediate_quit = 0; /* If the file matches the buffer completely, there's no need to replace anything. */ if (same_at_start - BEGV == st.st_size) { close (fd); specpdl_ptr--; /* Truncate the buffer to the size of the file. */ del_range_1 (same_at_start, same_at_end, 0); goto handled; } immediate_quit = 1; QUIT; /* Count how many chars at the end of the file match the text at the end of the buffer. */ while (1) { int total_read, nread, bufpos, curpos, trial; /* At what file position are we now scanning? */ curpos = st.st_size - (ZV - same_at_end); /* If the entire file matches the buffer tail, stop the scan. */ if (curpos == 0) break; /* How much can we scan in the next step? */ trial = min (curpos, sizeof buffer); if (lseek (fd, curpos - trial, 0) < 0) report_file_error ("Setting file position", Fcons (filename, Qnil)); total_read = 0; while (total_read < trial) { nread = read (fd, buffer + total_read, trial - total_read); if (nread <= 0) error ("IO error reading %s: %s", XSTRING (filename)->data, err_str (errno)); total_read += nread; } /* Scan this bufferfull from the end, comparing with the Emacs buffer. */ bufpos = total_read; /* Compare with same_at_start to avoid counting some buffer text as matching both at the file's beginning and at the end. */ while (bufpos > 0 && same_at_end > same_at_start && FETCH_CHAR (same_at_end - 1) == buffer[bufpos - 1]) same_at_end--, bufpos--; /* If we found a discrepancy, stop the scan. Otherwise loop around and scan the preceding bufferfull. */ if (bufpos != 0) break; } immediate_quit = 0; /* Don't try to reuse the same piece of text twice. */ overlap = same_at_start - BEGV - (same_at_end + st.st_size - ZV); if (overlap > 0) same_at_end += overlap; /* Arrange to read only the nonmatching middle part of the file. */ XFASTINT (beg) = same_at_start - BEGV; XFASTINT (end) = st.st_size - (ZV - same_at_end); del_range_1 (same_at_start, same_at_end, 0); /* Insert from the file at the proper position. */ SET_PT (same_at_start); } #endif /* MSDOS */ total = XINT (end) - XINT (beg); { register Lisp_Object temp; /* Make sure point-max won't overflow after this insertion. */ XSET (temp, Lisp_Int, total); if (total != XINT (temp)) error ("maximum buffer size exceeded"); } if (NILP (visit) && total > 0) prepare_to_modify_buffer (point, point); move_gap (point); if (GAP_SIZE < total) make_gap (total - GAP_SIZE); if (XINT (beg) != 0 || !NILP (replace)) { if (lseek (fd, XINT (beg), 0) < 0) report_file_error ("Setting file position", Fcons (filename, Qnil)); } how_much = 0; while (inserted < total) { int try = min (total - inserted, 64 << 10); int this; /* Allow quitting out of the actual I/O. */ immediate_quit = 1; QUIT; this = read (fd, &FETCH_CHAR (point + inserted - 1) + 1, try); immediate_quit = 0; if (this <= 0) { how_much = this; break; } GPT += this; GAP_SIZE -= this; ZV += this; Z += this; inserted += this; } #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */ /* Determine file type from name and remove LFs from CR-LFs if the file is deemed to be a text file. */ { struct gcpro gcpro1; Lisp_Object code; code = Qnil; GCPRO1 (filename); current_buffer->buffer_file_type = call1 (Qfind_buffer_file_type, filename); UNGCPRO; if (NILP (current_buffer->buffer_file_type)) { int reduced_size = inserted - crlf_to_lf (inserted, &FETCH_CHAR (point - 1) + 1); ZV -= reduced_size; Z -= reduced_size; GPT -= reduced_size; GAP_SIZE += reduced_size; inserted -= reduced_size; } } #endif if (inserted > 0) { record_insert (point, inserted); /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */ offset_intervals (current_buffer, point, inserted); MODIFF++; } close (fd); /* Discard the unwind protect for closing the file. */ specpdl_ptr--; if (how_much < 0) error ("IO error reading %s: %s", XSTRING (filename)->data, err_str (errno)); notfound: handled: if (!NILP (visit)) { if (!EQ (current_buffer->undo_list, Qt)) current_buffer->undo_list = Qnil; #ifdef APOLLO stat (XSTRING (filename)->data, &st); #endif if (NILP (handler)) { current_buffer->modtime = st.st_mtime; current_buffer->filename = filename; } current_buffer->save_modified = MODIFF; current_buffer->auto_save_modified = MODIFF; XFASTINT (current_buffer->save_length) = Z - BEG; #ifdef CLASH_DETECTION if (NILP (handler)) { if (!NILP (current_buffer->filename)) unlock_file (current_buffer->filename); unlock_file (filename); } #endif /* CLASH_DETECTION */ /* If visiting nonexistent file, return nil. */ if (current_buffer->modtime == -1) report_file_error ("Opening input file", Fcons (filename, Qnil)); } if (inserted > 0 && NILP (visit) && total > 0) signal_after_change (point, 0, inserted); if (inserted > 0) { p = Vafter_insert_file_functions; while (!NILP (p)) { insval = call1 (Fcar (p), make_number (inserted)); if (!NILP (insval)) { CHECK_NUMBER (insval, 0); inserted = XFASTINT (insval); } QUIT; p = Fcdr (p); } } if (NILP (val)) val = Fcons (filename, Fcons (make_number (inserted), Qnil)); RETURN_UNGCPRO (unbind_to (count, val)); } static Lisp_Object build_annotations (); /* If build_annotations switched buffers, switch back to BUF. Kill the temporary buffer that was selected in the meantime. */ static Lisp_Object build_annotations_unwind (buf) Lisp_Object buf; { Lisp_Object tembuf; if (XBUFFER (buf) == current_buffer) return Qnil; tembuf = Fcurrent_buffer (); Fset_buffer (buf); Fkill_buffer (tembuf); return Qnil; } DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 5, "r\nFWrite region to file: ", "Write current region into specified file.\n\ When called from a program, takes three arguments:\n\ START, END and FILENAME. START and END are buffer positions.\n\ Optional fourth argument APPEND if non-nil means\n\ append to existing file contents (if any).\n\ Optional fifth argument VISIT if t means\n\ set the last-save-file-modtime of buffer to this file's modtime\n\ and mark buffer not modified.\n\ If VISIT is a string, it is a second file name;\n\ the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\ VISIT is also the file name to lock and unlock for clash detection.\n\ If VISIT is neither t nor nil nor a string,\n\ that means do not print the \"Wrote file\" message.\n\ Kludgy feature: if START is a string, then that string is written\n\ to the file, instead of any buffer contents, and END is ignored.") (start, end, filename, append, visit) Lisp_Object start, end, filename, append, visit; { register int desc; int failure; int save_errno; #ifdef VMS int save_vaxc$errno; #endif unsigned char *fn; struct stat st; int tem; int count = specpdl_ptr - specpdl; int count1; #ifdef VMS unsigned char *fname = 0; /* If non-0, original filename (must rename) */ #endif /* VMS */ Lisp_Object handler; Lisp_Object visit_file; Lisp_Object annotations; int visiting, quietly; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; struct buffer *given_buffer; #ifdef MSDOS int buffer_file_type = NILP (current_buffer->buffer_file_type) ? O_TEXT : O_BINARY; #endif if (!NILP (start) && !STRINGP (start)) validate_region (&start, &end); GCPRO2 (filename, visit); filename = Fexpand_file_name (filename, Qnil); if (STRINGP (visit)) visit_file = Fexpand_file_name (visit, Qnil); else visit_file = filename; UNGCPRO; visiting = (EQ (visit, Qt) || STRINGP (visit)); quietly = !NILP (visit); annotations = Qnil; GCPRO4 (start, filename, annotations, visit_file); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qwrite_region); /* If FILENAME has no handler, see if VISIT has one. */ if (NILP (handler) && XTYPE (visit) == Lisp_String) handler = Ffind_file_name_handler (visit, Qwrite_region); if (!NILP (handler)) { Lisp_Object val; val = call6 (handler, Qwrite_region, start, end, filename, append, visit); if (visiting) { current_buffer->save_modified = MODIFF; XFASTINT (current_buffer->save_length) = Z - BEG; current_buffer->filename = visit_file; } UNGCPRO; return val; } /* Special kludge to simplify auto-saving. */ if (NILP (start)) { XFASTINT (start) = BEG; XFASTINT (end) = Z; } record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ()); count1 = specpdl_ptr - specpdl; given_buffer = current_buffer; annotations = build_annotations (start, end); if (current_buffer != given_buffer) { start = BEGV; end = ZV; } #ifdef CLASH_DETECTION if (!auto_saving) lock_file (visit_file); #endif /* CLASH_DETECTION */ fn = XSTRING (filename)->data; desc = -1; if (!NILP (append)) #ifdef MSDOS desc = open (fn, O_WRONLY | buffer_file_type); #else desc = open (fn, O_WRONLY); #endif if (desc < 0) #ifdef VMS if (auto_saving) /* Overwrite any previous version of autosave file */ { vms_truncate (fn); /* if fn exists, truncate to zero length */ desc = open (fn, O_RDWR); if (desc < 0) desc = creat_copy_attrs (STRINGP (current_buffer->filename) ? XSTRING (current_buffer->filename)->data : 0, fn); } else /* Write to temporary name and rename if no errors */ { Lisp_Object temp_name; temp_name = Ffile_name_directory (filename); if (!NILP (temp_name)) { temp_name = Fmake_temp_name (concat2 (temp_name, build_string ("$$SAVE$$"))); fname = XSTRING (filename)->data; fn = XSTRING (temp_name)->data; desc = creat_copy_attrs (fname, fn); if (desc < 0) { /* If we can't open the temporary file, try creating a new version of the original file. VMS "creat" creates a new version rather than truncating an existing file. */ fn = fname; fname = 0; desc = creat (fn, 0666); #if 0 /* This can clobber an existing file and fail to replace it, if the user runs out of space. */ if (desc < 0) { /* We can't make a new version; try to truncate and rewrite existing version if any. */ vms_truncate (fn); desc = open (fn, O_RDWR); } #endif } } else desc = creat (fn, 0666); } #else /* not VMS */ #ifdef MSDOS desc = open (fn, O_WRONLY | O_TRUNC | O_CREAT | buffer_file_type, S_IREAD | S_IWRITE); #else /* not MSDOS */ desc = creat (fn, auto_saving ? auto_save_mode_bits : 0666); #endif /* not MSDOS */ #endif /* not VMS */ UNGCPRO; if (desc < 0) { #ifdef CLASH_DETECTION save_errno = errno; #ifdef VMS save_vaxc$errno = vaxc$errno; #endif if (!auto_saving) unlock_file (visit_file); errno = save_errno; #ifdef VMS vaxc$errno = save_vaxc$errno; #endif #endif /* CLASH_DETECTION */ report_file_error ("Opening output file", Fcons (filename, Qnil)); } record_unwind_protect (close_file_unwind, make_number (desc)); if (!NILP (append)) if (lseek (desc, 0, 2) < 0) { #ifdef CLASH_DETECTION if (!auto_saving) unlock_file (visit_file); #endif /* CLASH_DETECTION */ report_file_error ("Lseek error", Fcons (filename, Qnil)); } #ifdef VMS /* * Kludge Warning: The VMS C RTL likes to insert carriage returns * if we do writes that don't end with a carriage return. Furthermore * it cannot handle writes of more then 16K. The modified * version of "sys_write" in SYSDEP.C (see comment there) copes with * this EXCEPT for the last record (iff it doesn't end with a carriage * return). This implies that if your buffer doesn't end with a carriage * return, you get one free... tough. However it also means that if * we make two calls to sys_write (a la the following code) you can * get one at the gap as well. The easiest way to fix this (honest) * is to move the gap to the next newline (or the end of the buffer). * If the file has fixed-length records, it is essential to move the gap * to a record boundary. The easiest way to do this is to just move the * gap all the way to the end of the buffer. * Thus this change. * * Yech! */ #if 0 if (GPT > BEG && GPT_ADDR[-1] != '\n') move_gap (find_next_newline (GPT, 1)); #endif if (GPT > BEG && GPT < Z) move_gap (Z); #endif /* VMS */ failure = 0; immediate_quit = 1; if (STRINGP (start)) { failure = 0 > a_write (desc, XSTRING (start)->data, XSTRING (start)->size, 0, &annotations); save_errno = errno; #ifdef VMS save_vaxc$errno = vaxc$errno; #endif } else if (XINT (start) != XINT (end)) { int nwritten = 0; if (XINT (start) < GPT) { register int end1 = XINT (end); tem = XINT (start); failure = 0 > a_write (desc, &FETCH_CHAR (tem), min (GPT, end1) - tem, tem, &annotations); nwritten += min (GPT, end1) - tem; save_errno = errno; #ifdef VMS save_vaxc$errno = vaxc$errno; #endif } if (XINT (end) > GPT && !failure) { tem = XINT (start); tem = max (tem, GPT); failure = 0 > a_write (desc, &FETCH_CHAR (tem), XINT (end) - tem, tem, &annotations); nwritten += XINT (end) - tem; save_errno = errno; #ifdef VMS save_vaxc$errno = vaxc$errno; #endif } if (nwritten == 0) { /* If file was empty, still need to write the annotations */ failure = 0 > a_write (desc, "", 0, XINT (start), &annotations); save_errno = errno; #ifdef VMS save_vaxc$errno = vaxc$errno; #endif } } immediate_quit = 0; #ifdef HAVE_FSYNC /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun). Disk full in NFS may be reported here. */ /* mib says that closing the file will try to write as fast as NFS can do it, and that means the fsync here is not crucial for autosave files. */ #ifdef VMS if (!auto_saving && fsync (desc) < 0) failure = 1, save_errno = errno, save_vaxc$errno = vaxc$errno; #else if (!auto_saving && fsync (desc) < 0) failure = 1, save_errno = errno; #endif #endif /* Spurious "file has changed on disk" warnings have been observed on Suns as well. It seems that `close' can change the modtime, under nfs. (This has supposedly been fixed in Sunos 4, but who knows about all the other machines with NFS?) */ #if 0 /* On VMS and APOLLO, must do the stat after the close since closing changes the modtime. */ #ifndef VMS #ifndef APOLLO /* Recall that #if defined does not work on VMS. */ #define FOO fstat (desc, &st); #endif #endif #endif /* NFS can report a write failure now. */ #ifdef VMS if (close (desc) < 0) failure = 1, save_errno = errno, save_vaxc$errno = vaxc$errno; #else if (close (desc) < 0) failure = 1, save_errno = errno; #endif #ifdef VMS /* If we wrote to a temporary name and had no errors, rename to real name. */ if (fname) { #ifdef VMS if (!failure) failure = (rename (fn, fname) != 0), save_errno = errno, save_vaxc$errno = vaxc$errno; #else if (!failure) failure = (rename (fn, fname) != 0), save_errno = errno; #endif fn = fname; } #endif /* VMS */ #ifndef FOO stat (fn, &st); #endif /* Discard the unwind protect for close_file_unwind. */ specpdl_ptr = specpdl + count1; /* Restore the original current buffer. */ visit_file = unbind_to (count, visit_file); #ifdef CLASH_DETECTION if (!auto_saving) unlock_file (visit_file); #endif /* CLASH_DETECTION */ /* Do this before reporting IO error to avoid a "file has changed on disk" warning on next attempt to save. */ if (visiting) current_buffer->modtime = st.st_mtime; if (failure) #ifndef VMS error ("IO error writing %s: %s", fn, strerror (save_errno)); #else error ("IO error writing %s: %s", fn, strerror (save_errno, save_vaxc$errno)); #endif if (visiting) { current_buffer->save_modified = MODIFF; XFASTINT (current_buffer->save_length) = Z - BEG; current_buffer->filename = visit_file; update_mode_lines++; } else if (quietly) return Qnil; if (!auto_saving) message ("Wrote %s", XSTRING (visit_file)->data); return Qnil; } Lisp_Object merge (); DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0, "Return t if (car A) is numerically less than (car B).") (a, b) Lisp_Object a, b; { return Flss (Fcar (a), Fcar (b)); } /* Build the complete list of annotations appropriate for writing out the text between START and END, by calling all the functions in write-region-annotate-functions and merging the lists they return. If one of these functions switches to a different buffer, we assume that buffer contains altered text. Therefore, the caller must make sure to restore the current buffer in all cases, as save-excursion would do. */ static Lisp_Object build_annotations (start, end) Lisp_Object start, end; { Lisp_Object annotations; Lisp_Object p, res; struct gcpro gcpro1, gcpro2; annotations = Qnil; p = Vwrite_region_annotate_functions; GCPRO2 (annotations, p); while (!NILP (p)) { struct buffer *given_buffer = current_buffer; Vwrite_region_annotations_so_far = annotations; res = call2 (Fcar (p), start, end); /* If the function makes a different buffer current, assume that means this buffer contains altered text to be output. Reset START and END from the buffer bounds and discard all previous annotations because they should have been dealt with by this function. */ if (current_buffer != given_buffer) { start = BEGV; end = ZV; annotations = Qnil; } Flength (res); /* Check basic validity of return value */ annotations = merge (annotations, res, Qcar_less_than_car); p = Fcdr (p); } UNGCPRO; return annotations; } /* Write to descriptor DESC the LEN characters starting at ADDR, assuming they start at position POS in the buffer. Intersperse with them the annotations from *ANNOT (those which fall within the range of positions POS to POS + LEN), each at its appropriate position. Modify *ANNOT by discarding elements as we output them. The return value is negative in case of system call failure. */ int a_write (desc, addr, len, pos, annot) int desc; register char *addr; register int len; int pos; Lisp_Object *annot; { Lisp_Object tem; int nextpos; int lastpos = pos + len; while (NILP (*annot) || CONSP (*annot)) { tem = Fcar_safe (Fcar (*annot)); if (INTEGERP (tem) && XINT (tem) >= pos && XFASTINT (tem) <= lastpos) nextpos = XFASTINT (tem); else return e_write (desc, addr, lastpos - pos); if (nextpos > pos) { if (0 > e_write (desc, addr, nextpos - pos)) return -1; addr += nextpos - pos; pos = nextpos; } tem = Fcdr (Fcar (*annot)); if (STRINGP (tem)) { if (0 > e_write (desc, XSTRING (tem)->data, XSTRING (tem)->size)) return -1; } *annot = Fcdr (*annot); } } int e_write (desc, addr, len) int desc; register char *addr; register int len; { char buf[16 * 1024]; register char *p, *end; if (!EQ (current_buffer->selective_display, Qt)) return write (desc, addr, len) - len; else { p = buf; end = p + sizeof buf; while (len--) { if (p == end) { if (write (desc, buf, sizeof buf) != sizeof buf) return -1; p = buf; } *p = *addr++; if (*p++ == '\015') p[-1] = '\n'; } if (p != buf) if (write (desc, buf, p - buf) != p - buf) return -1; } return 0; } DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, Sverify_visited_file_modtime, 1, 1, 0, "Return t if last mod time of BUF's visited file matches what BUF records.\n\ This means that the file has not been changed since it was visited or saved.") (buf) Lisp_Object buf; { struct buffer *b; struct stat st; Lisp_Object handler; CHECK_BUFFER (buf, 0); b = XBUFFER (buf); if (XTYPE (b->filename) != Lisp_String) return Qt; if (b->modtime == 0) return Qt; /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (b->filename, Qverify_visited_file_modtime); if (!NILP (handler)) return call2 (handler, Qverify_visited_file_modtime, buf); if (stat (XSTRING (b->filename)->data, &st) < 0) { /* If the file doesn't exist now and didn't exist before, we say that it isn't modified, provided the error is a tame one. */ if (errno == ENOENT || errno == EACCES || errno == ENOTDIR) st.st_mtime = -1; else st.st_mtime = 0; } if (st.st_mtime == b->modtime /* If both are positive, accept them if they are off by one second. */ || (st.st_mtime > 0 && b->modtime > 0 && (st.st_mtime == b->modtime + 1 || st.st_mtime == b->modtime - 1))) return Qt; return Qnil; } DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime, Sclear_visited_file_modtime, 0, 0, 0, "Clear out records of last mod time of visited file.\n\ Next attempt to save will certainly not complain of a discrepancy.") () { current_buffer->modtime = 0; return Qnil; } DEFUN ("visited-file-modtime", Fvisited_file_modtime, Svisited_file_modtime, 0, 0, 0, "Return the current buffer's recorded visited file modification time.\n\ The value is a list of the form (HIGH . LOW), like the time values\n\ that `file-attributes' returns.") () { return long_to_cons (current_buffer->modtime); } DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, Sset_visited_file_modtime, 0, 1, 0, "Update buffer's recorded modification time from the visited file's time.\n\ Useful if the buffer was not read from the file normally\n\ or if the file itself has been changed for some known benign reason.\n\ An argument specifies the modification time value to use\n\ \(instead of that of the visited file), in the form of a list\n\ \(HIGH . LOW) or (HIGH LOW).") (time_list) Lisp_Object time_list; { if (!NILP (time_list)) current_buffer->modtime = cons_to_long (time_list); else { register Lisp_Object filename; struct stat st; Lisp_Object handler; filename = Fexpand_file_name (current_buffer->filename, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime); if (!NILP (handler)) /* The handler can find the file name the same way we did. */ return call2 (handler, Qset_visited_file_modtime, Qnil); else if (stat (XSTRING (filename)->data, &st) >= 0) current_buffer->modtime = st.st_mtime; } return Qnil; } Lisp_Object auto_save_error () { ring_bell (); message ("Autosaving...error for %s", XSTRING (current_buffer->name)->data); Fsleep_for (make_number (1), Qnil); message ("Autosaving...error!for %s", XSTRING (current_buffer->name)->data); Fsleep_for (make_number (1), Qnil); message ("Autosaving...error for %s", XSTRING (current_buffer->name)->data); Fsleep_for (make_number (1), Qnil); return Qnil; } Lisp_Object auto_save_1 () { unsigned char *fn; struct stat st; /* Get visited file's mode to become the auto save file's mode. */ if (stat (XSTRING (current_buffer->filename)->data, &st) >= 0) /* But make sure we can overwrite it later! */ auto_save_mode_bits = st.st_mode | 0600; else auto_save_mode_bits = 0666; return Fwrite_region (Qnil, Qnil, current_buffer->auto_save_file_name, Qnil, Qlambda); } static Lisp_Object do_auto_save_unwind (desc) /* used as unwind-protect function */ Lisp_Object desc; { close (XINT (desc)); return Qnil; } DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "", "Auto-save all buffers that need it.\n\ This is all buffers that have auto-saving enabled\n\ and are changed since last auto-saved.\n\ Auto-saving writes the buffer into a file\n\ so that your editing is not lost if the system crashes.\n\ This file is not the file you visited; that changes only when you save.\n\ Normally we run the normal hook `auto-save-hook' before saving.\n\n\ Non-nil first argument means do not print any message if successful.\n\ Non-nil second argument means save only current buffer.") (no_message, current_only) Lisp_Object no_message, current_only; { struct buffer *old = current_buffer, *b; Lisp_Object tail, buf; int auto_saved = 0; char *omessage = echo_area_glyphs; int omessage_length = echo_area_glyphs_length; extern int minibuf_level; int do_handled_files; Lisp_Object oquit; int listdesc; int count = specpdl_ptr - specpdl; int *ptr; /* Ordinarily don't quit within this function, but don't make it impossible to quit (in case we get hung in I/O). */ oquit = Vquit_flag; Vquit_flag = Qnil; /* No GCPRO needed, because (when it matters) all Lisp_Object variables point to non-strings reached from Vbuffer_alist. */ auto_saving = 1; if (minibuf_level) no_message = Qt; if (!NILP (Vrun_hooks)) call1 (Vrun_hooks, intern ("auto-save-hook")); if (STRINGP (Vauto_save_list_file_name)) { #ifdef MSDOS listdesc = open (XSTRING (Vauto_save_list_file_name)->data, O_WRONLY | O_TRUNC | O_CREAT | O_TEXT, S_IREAD | S_IWRITE); #else /* not MSDOS */ listdesc = creat (XSTRING (Vauto_save_list_file_name)->data, 0666); #endif /* not MSDOS */ } else listdesc = -1; /* Arrange to close that file whether or not we get an error. */ if (listdesc >= 0) record_unwind_protect (do_auto_save_unwind, make_number (listdesc)); /* First, save all files which don't have handlers. If Emacs is crashing, the handlers may tweak what is causing Emacs to crash in the first place, and it would be a shame if Emacs failed to autosave perfectly ordinary files because it couldn't handle some ange-ftp'd file. */ for (do_handled_files = 0; do_handled_files < 2; do_handled_files++) for (tail = Vbuffer_alist; XGCTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) { buf = XCONS (XCONS (tail)->car)->cdr; b = XBUFFER (buf); /* Record all the buffers that have auto save mode in the special file that lists them. */ if (XTYPE (b->auto_save_file_name) == Lisp_String && listdesc >= 0 && do_handled_files == 0) { write (listdesc, XSTRING (b->auto_save_file_name)->data, XSTRING (b->auto_save_file_name)->size); write (listdesc, "\n", 1); } if (!NILP (current_only) && b != current_buffer) continue; /* Check for auto save enabled and file changed since last auto save and file changed since last real save. */ if (XTYPE (b->auto_save_file_name) == Lisp_String && b->save_modified < BUF_MODIFF (b) && b->auto_save_modified < BUF_MODIFF (b) /* -1 means we've turned off autosaving for a while--see below. */ && XINT (b->save_length) >= 0 && (do_handled_files || NILP (Ffind_file_name_handler (b->auto_save_file_name, Qwrite_region)))) { EMACS_TIME before_time, after_time; EMACS_GET_TIME (before_time); /* If we had a failure, don't try again for 20 minutes. */ if (b->auto_save_failure_time >= 0 && EMACS_SECS (before_time) - b->auto_save_failure_time < 1200) continue; if ((XFASTINT (b->save_length) * 10 > (BUF_Z (b) - BUF_BEG (b)) * 13) /* A short file is likely to change a large fraction; spare the user annoying messages. */ && XFASTINT (b->save_length) > 5000 /* These messages are frequent and annoying for `*mail*'. */ && !EQ (b->filename, Qnil) && NILP (no_message)) { /* It has shrunk too much; turn off auto-saving here. */ message ("Buffer %s has shrunk a lot; auto save turned off there", XSTRING (b->name)->data); /* Turn off auto-saving until there's a real save, and prevent any more warnings. */ XSET (b->save_length, Lisp_Int, -1); Fsleep_for (make_number (1), Qnil); continue; } set_buffer_internal (b); if (!auto_saved && NILP (no_message)) message1 ("Auto-saving..."); internal_condition_case (auto_save_1, Qt, auto_save_error); auto_saved++; b->auto_save_modified = BUF_MODIFF (b); XFASTINT (current_buffer->save_length) = Z - BEG; set_buffer_internal (old); EMACS_GET_TIME (after_time); /* If auto-save took more than 60 seconds, assume it was an NFS failure that got a timeout. */ if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60) b->auto_save_failure_time = EMACS_SECS (after_time); } } /* Prevent another auto save till enough input events come in. */ record_auto_save (); if (auto_saved && NILP (no_message)) { if (omessage) message2 (omessage, omessage_length); else message1 ("Auto-saving...done"); } Vquit_flag = oquit; auto_saving = 0; unbind_to (count, Qnil); return Qnil; } DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, Sset_buffer_auto_saved, 0, 0, 0, "Mark current buffer as auto-saved with its current text.\n\ No auto-save file will be written until the buffer changes again.") () { current_buffer->auto_save_modified = MODIFF; XFASTINT (current_buffer->save_length) = Z - BEG; current_buffer->auto_save_failure_time = -1; return Qnil; } DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, Sclear_buffer_auto_save_failure, 0, 0, 0, "Clear any record of a recent auto-save failure in the current buffer.") () { current_buffer->auto_save_failure_time = -1; return Qnil; } DEFUN ("recent-auto-save-p", Frecent_auto_save_p, Srecent_auto_save_p, 0, 0, 0, "Return t if buffer has been auto-saved since last read in or saved.") () { return (current_buffer->save_modified < current_buffer->auto_save_modified) ? Qt : Qnil; } /* Reading and completing file names */ extern Lisp_Object Ffile_name_completion (), Ffile_name_all_completions (); /* In the string VAL, change each $ to $$ and return the result. */ static Lisp_Object double_dollars (val) Lisp_Object val; { #ifndef VMS register unsigned char *old, *new; register int n; int osize, count; osize = XSTRING (val)->size; /* Quote "$" as "$$" to get it past substitute-in-file-name */ for (n = osize, count = 0, old = XSTRING (val)->data; n > 0; n--) if (*old++ == '$') count++; if (count > 0) { old = XSTRING (val)->data; val = Fmake_string (make_number (osize + count), make_number (0)); new = XSTRING (val)->data; for (n = osize; n > 0; n--) if (*old != '$') *new++ = *old++; else { *new++ = '$'; *new++ = '$'; old++; } } #endif return val; } DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_internal, 3, 3, 0, "Internal subroutine for read-file-name. Do not call this.") (string, dir, action) Lisp_Object string, dir, action; /* action is nil for complete, t for return list of completions, lambda for verify final value */ { Lisp_Object name, specdir, realdir, val, orig_string; int changed; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; realdir = dir; name = string; orig_string = Qnil; specdir = Qnil; changed = 0; /* No need to protect ACTION--we only compare it with t and nil. */ GCPRO4 (string, realdir, name, specdir); if (XSTRING (string)->size == 0) { if (EQ (action, Qlambda)) { UNGCPRO; return Qnil; } } else { orig_string = string; string = Fsubstitute_in_file_name (string); changed = NILP (Fstring_equal (string, orig_string)); name = Ffile_name_nondirectory (string); val = Ffile_name_directory (string); if (! NILP (val)) realdir = Fexpand_file_name (val, realdir); } if (NILP (action)) { specdir = Ffile_name_directory (string); val = Ffile_name_completion (name, realdir); UNGCPRO; if (XTYPE (val) != Lisp_String) { if (changed) return double_dollars (string); return val; } if (!NILP (specdir)) val = concat2 (specdir, val); #ifndef VMS return double_dollars (val); #else /* not VMS */ return val; #endif /* not VMS */ } UNGCPRO; if (EQ (action, Qt)) return Ffile_name_all_completions (name, realdir); /* Only other case actually used is ACTION = lambda */ #ifdef VMS /* Supposedly this helps commands such as `cd' that read directory names, but can someone explain how it helps them? -- RMS */ if (XSTRING (name)->size == 0) return Qt; #endif /* VMS */ return Ffile_exists_p (string); } DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0, "Read file name, prompting with PROMPT and completing in directory DIR.\n\ Value is not expanded---you must call `expand-file-name' yourself.\n\ Default name to DEFAULT if user enters a null string.\n\ (If DEFAULT is omitted, the visited file name is used.)\n\ Fourth arg MUSTMATCH non-nil means require existing file's name.\n\ Non-nil and non-t means also require confirmation after completion.\n\ Fifth arg INITIAL specifies text to start with.\n\ DIR defaults to current buffer's directory default.") (prompt, dir, defalt, mustmatch, initial) Lisp_Object prompt, dir, defalt, mustmatch, initial; { Lisp_Object val, insdef, insdef1, tem; struct gcpro gcpro1, gcpro2; register char *homedir; int count; if (NILP (dir)) dir = current_buffer->directory; if (NILP (defalt)) defalt = current_buffer->filename; /* If dir starts with user's homedir, change that to ~. */ homedir = (char *) egetenv ("HOME"); if (homedir != 0 && XTYPE (dir) == Lisp_String && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir)) && XSTRING (dir)->data[strlen (homedir)] == '/') { dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1, XSTRING (dir)->size - strlen (homedir) + 1); XSTRING (dir)->data[0] = '~'; } if (insert_default_directory) { insdef = dir; if (!NILP (initial)) { Lisp_Object args[2], pos; args[0] = insdef; args[1] = initial; insdef = Fconcat (2, args); pos = make_number (XSTRING (double_dollars (dir))->size); insdef1 = Fcons (double_dollars (insdef), pos); } else insdef1 = double_dollars (insdef); } else if (!NILP (initial)) { insdef = initial; insdef1 = Fcons (double_dollars (insdef), 0); } else insdef = Qnil, insdef1 = Qnil; #ifdef VMS count = specpdl_ptr - specpdl; specbind (intern ("completion-ignore-case"), Qt); #endif GCPRO2 (insdef, defalt); val = Fcompleting_read (prompt, intern ("read-file-name-internal"), dir, mustmatch, insdef1, Qfile_name_history); #ifdef VMS unbind_to (count, Qnil); #endif UNGCPRO; if (NILP (val)) error ("No file name specified"); tem = Fstring_equal (val, insdef); if (!NILP (tem) && !NILP (defalt)) return defalt; if (XSTRING (val)->size == 0 && NILP (insdef)) { if (!NILP (defalt)) return defalt; else error ("No default file name"); } return Fsubstitute_in_file_name (val); } #if 0 /* Old version */ DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) (prompt, dir, defalt, mustmatch, initial) Lisp_Object prompt, dir, defalt, mustmatch, initial; { Lisp_Object val, insdef, tem; struct gcpro gcpro1, gcpro2; register char *homedir; int count; if (NILP (dir)) dir = current_buffer->directory; if (NILP (defalt)) defalt = current_buffer->filename; /* If dir starts with user's homedir, change that to ~. */ homedir = (char *) egetenv ("HOME"); if (homedir != 0 && XTYPE (dir) == Lisp_String && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir)) && XSTRING (dir)->data[strlen (homedir)] == '/') { dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1, XSTRING (dir)->size - strlen (homedir) + 1); XSTRING (dir)->data[0] = '~'; } if (!NILP (initial)) insdef = initial; else if (insert_default_directory) insdef = dir; else insdef = build_string (""); #ifdef VMS count = specpdl_ptr - specpdl; specbind (intern ("completion-ignore-case"), Qt); #endif GCPRO2 (insdef, defalt); val = Fcompleting_read (prompt, intern ("read-file-name-internal"), dir, mustmatch, insert_default_directory ? insdef : Qnil, Qfile_name_history); #ifdef VMS unbind_to (count, Qnil); #endif UNGCPRO; if (NILP (val)) error ("No file name specified"); tem = Fstring_equal (val, insdef); if (!NILP (tem) && !NILP (defalt)) return defalt; return Fsubstitute_in_file_name (val); } #endif /* Old version */ syms_of_fileio () { Qexpand_file_name = intern ("expand-file-name"); Qdirectory_file_name = intern ("directory-file-name"); Qfile_name_directory = intern ("file-name-directory"); Qfile_name_nondirectory = intern ("file-name-nondirectory"); Qunhandled_file_name_directory = intern ("unhandled-file-name-directory"); Qfile_name_as_directory = intern ("file-name-as-directory"); Qcopy_file = intern ("copy-file"); Qmake_directory_internal = intern ("make-directory-internal"); Qdelete_directory = intern ("delete-directory"); Qdelete_file = intern ("delete-file"); Qrename_file = intern ("rename-file"); Qadd_name_to_file = intern ("add-name-to-file"); Qmake_symbolic_link = intern ("make-symbolic-link"); Qfile_exists_p = intern ("file-exists-p"); Qfile_executable_p = intern ("file-executable-p"); Qfile_readable_p = intern ("file-readable-p"); Qfile_symlink_p = intern ("file-symlink-p"); Qfile_writable_p = intern ("file-writable-p"); Qfile_directory_p = intern ("file-directory-p"); Qfile_accessible_directory_p = intern ("file-accessible-directory-p"); Qfile_modes = intern ("file-modes"); Qset_file_modes = intern ("set-file-modes"); Qfile_newer_than_file_p = intern ("file-newer-than-file-p"); Qinsert_file_contents = intern ("insert-file-contents"); Qwrite_region = intern ("write-region"); Qverify_visited_file_modtime = intern ("verify-visited-file-modtime"); Qset_visited_file_modtime = intern ("set-visited-file-modtime"); staticpro (&Qexpand_file_name); staticpro (&Qdirectory_file_name); staticpro (&Qfile_name_directory); staticpro (&Qfile_name_nondirectory); staticpro (&Qunhandled_file_name_directory); staticpro (&Qfile_name_as_directory); staticpro (&Qcopy_file); staticpro (&Qmake_directory_internal); staticpro (&Qdelete_directory); staticpro (&Qdelete_file); staticpro (&Qrename_file); staticpro (&Qadd_name_to_file); staticpro (&Qmake_symbolic_link); staticpro (&Qfile_exists_p); staticpro (&Qfile_executable_p); staticpro (&Qfile_readable_p); staticpro (&Qfile_symlink_p); staticpro (&Qfile_writable_p); staticpro (&Qfile_directory_p); staticpro (&Qfile_accessible_directory_p); staticpro (&Qfile_modes); staticpro (&Qset_file_modes); staticpro (&Qfile_newer_than_file_p); staticpro (&Qinsert_file_contents); staticpro (&Qwrite_region); staticpro (&Qverify_visited_file_modtime); Qfile_name_history = intern ("file-name-history"); Fset (Qfile_name_history, Qnil); staticpro (&Qfile_name_history); Qfile_error = intern ("file-error"); staticpro (&Qfile_error); Qfile_already_exists = intern("file-already-exists"); staticpro (&Qfile_already_exists); #ifdef MSDOS Qfind_buffer_file_type = intern ("find-buffer-file-type"); staticpro (&Qfind_buffer_file_type); #endif Qcar_less_than_car = intern ("car-less-than-car"); staticpro (&Qcar_less_than_car); Fput (Qfile_error, Qerror_conditions, Fcons (Qfile_error, Fcons (Qerror, Qnil))); Fput (Qfile_error, Qerror_message, build_string ("File error")); Fput (Qfile_already_exists, Qerror_conditions, Fcons (Qfile_already_exists, Fcons (Qfile_error, Fcons (Qerror, Qnil)))); Fput (Qfile_already_exists, Qerror_message, build_string ("File already exists")); DEFVAR_BOOL ("insert-default-directory", &insert_default_directory, "*Non-nil means when reading a filename start with default dir in minibuffer."); insert_default_directory = 1; DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm, "*Non-nil means write new files with record format `stmlf'.\n\ nil means use format `var'. This variable is meaningful only on VMS."); vms_stmlf_recfm = 0; DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist, "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\ If a file name matches REGEXP, then all I/O on that file is done by calling\n\ HANDLER.\n\ \n\ The first argument given to HANDLER is the name of the I/O primitive\n\ to be handled; the remaining arguments are the arguments that were\n\ passed to that primitive. For example, if you do\n\ (file-exists-p FILENAME)\n\ and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\ (funcall HANDLER 'file-exists-p FILENAME)\n\ The function `find-file-name-handler' checks this list for a handler\n\ for its argument."); Vfile_name_handler_alist = Qnil; DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions, "A list of functions to be called at the end of `insert-file-contents'.\n\ Each is passed one argument, the number of bytes inserted. It should return\n\ the new byte count, and leave point the same. If `insert-file-contents' is\n\ intercepted by a handler from `file-name-handler-alist', that handler is\n\ responsible for calling the after-insert-file-functions if appropriate."); Vafter_insert_file_functions = Qnil; DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions, "A list of functions to be called at the start of `write-region'.\n\ Each is passed two arguments, START and END as for `write-region'. It should\n\ return a list of pairs (POSITION . STRING) of strings to be effectively\n\ inserted at the specified positions of the file being written (1 means to\n\ insert before the first byte written). The POSITIONs must be sorted into\n\ increasing order. If there are several functions in the list, the several\n\ lists are merged destructively."); Vwrite_region_annotate_functions = Qnil; DEFVAR_LISP ("write-region-annotations-so-far", &Vwrite_region_annotations_so_far, "When an annotation function is called, this holds the previous annotations.\n\ These are the annotations made by other annotation functions\n\ that were already called. See also `write-region-annotate-functions'."); Vwrite_region_annotations_so_far = Qnil; DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers, "A list of file name handlers that temporarily should not be used.\n\ This applies only to the operation `inhibit-file-name-operation'."); Vinhibit_file_name_handlers = Qnil; DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation, "The operation for which `inhibit-file-name-handlers' is applicable."); Vinhibit_file_name_operation = Qnil; DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name, "File name in which we write a list of all auto save file names."); Vauto_save_list_file_name = Qnil; defsubr (&Sfind_file_name_handler); defsubr (&Sfile_name_directory); defsubr (&Sfile_name_nondirectory); defsubr (&Sunhandled_file_name_directory); defsubr (&Sfile_name_as_directory); defsubr (&Sdirectory_file_name); defsubr (&Smake_temp_name); defsubr (&Sexpand_file_name); defsubr (&Ssubstitute_in_file_name); defsubr (&Scopy_file); defsubr (&Smake_directory_internal); defsubr (&Sdelete_directory); defsubr (&Sdelete_file); defsubr (&Srename_file); defsubr (&Sadd_name_to_file); #ifdef S_IFLNK defsubr (&Smake_symbolic_link); #endif /* S_IFLNK */ #ifdef VMS defsubr (&Sdefine_logical_name); #endif /* VMS */ #ifdef HPUX_NET defsubr (&Ssysnetunam); #endif /* HPUX_NET */ defsubr (&Sfile_name_absolute_p); defsubr (&Sfile_exists_p); defsubr (&Sfile_executable_p); defsubr (&Sfile_readable_p); defsubr (&Sfile_writable_p); defsubr (&Sfile_symlink_p); defsubr (&Sfile_directory_p); defsubr (&Sfile_accessible_directory_p); defsubr (&Sfile_modes); defsubr (&Sset_file_modes); defsubr (&Sset_default_file_modes); defsubr (&Sdefault_file_modes); defsubr (&Sfile_newer_than_file_p); defsubr (&Sinsert_file_contents); defsubr (&Swrite_region); defsubr (&Scar_less_than_car); defsubr (&Sverify_visited_file_modtime); defsubr (&Sclear_visited_file_modtime); defsubr (&Svisited_file_modtime); defsubr (&Sset_visited_file_modtime); defsubr (&Sdo_auto_save); defsubr (&Sset_buffer_auto_saved); defsubr (&Sclear_buffer_auto_save_failure); defsubr (&Srecent_auto_save_p); defsubr (&Sread_file_name_internal); defsubr (&Sread_file_name); #ifdef unix defsubr (&Sunix_sync); #endif } r (&Sinsert_file_contents); defsubr (&Swrite_region); defsubr (&Scar_less_emacs-19_28/src/m/ 755 23 204 0 6027033171 6665 emacs-19_28/src/s/ 755 23 204 0 6002671352 6675 emacs-19_28/src/sysdep.c 644 23 204 410726 6027634704 10254 /* Interfaces to system-dependent kernel and library entries. Copyright (C) 1985, 86, 87, 88, 93, 94 Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs 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 2, or (at your option) any later version. GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #include #include #include #include "lisp.h" #include "blockinput.h" #undef NULL #define min(x,y) ((x) > (y) ? (y) : (x)) /* In this file, open, read and write refer to the system calls, not our sugared interfaces sys_open, sys_read and sys_write. Contrariwise, for systems where we use the system calls directly, define sys_read, etc. here as aliases for them. */ #ifndef read #define sys_read read #define sys_write write #endif /* `read' is not a macro */ #undef read #undef write #ifndef close #define sys_close close #else #undef close #endif #ifndef open #define sys_open open #else /* `open' is a macro */ #undef open #endif /* `open' is a macro */ /* Does anyone other than VMS need this? */ #ifndef fwrite #define sys_fwrite fwrite #else #undef fwrite #endif #ifndef HAVE_H_ERRNO extern int h_errno; #endif #include #include #include #include #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida, MW Aug 1993 */ #include #include "dosfns.h" #include "msdos.h" #include #endif extern int errno; #if 0 #define ASTDEBUG #endif #ifdef VMS #include #include #include #include #include #include #include #include #include #include #include #include #include #include #undef F_SETFL #ifndef RAB$C_BID #include #endif #define MAXIOSIZE ( 32 * PAGESIZE ) /* Don't I/O more than 32 blocks at a time */ #endif /* VMS */ #ifndef BSD4_1 #ifdef BSD /* this is done this way to avoid defined (BSD) || defined (USG) because the vms compiler doesn't grok `defined' */ #include #endif #ifdef USG #ifndef USG5 #include #endif #endif #endif /* not 4.1 bsd */ #ifdef BROKEN_FASYNC /* On some systems (DGUX comes to mind real fast) FASYNC causes background writes to the terminal to stop all processes in the process group when invoked under the csh (and probably any shell with job control). This stops Emacs dead in its tracks when coming up under X11. */ #undef FASYNC #endif #ifndef MSDOS #include #endif #include "systty.h" #include "syswait.h" #ifdef BROKEN_TIOCGWINSZ #undef TIOCGWINSZ #undef TIOCSWINSZ #endif #ifdef USG #include #include #ifndef MEMORY_IN_STRING_H #include #endif #if defined (TIOCGWINSZ) || defined (ISC4_0) #ifdef NEED_SIOCTL #include #endif #ifdef NEED_PTEM_H #include #include #endif #endif /* TIOCGWINSZ or ISC4_0 */ #endif /* USG */ extern int quit_char; #include "frame.h" #include "window.h" #include "termhooks.h" #include "termchar.h" #include "termopts.h" #include "dispextern.h" #include "process.h" #ifdef NONSYSTEM_DIR_LIBRARY #include "ndir.h" #endif /* NONSYSTEM_DIR_LIBRARY */ #include "syssignal.h" #include "systime.h" /* LPASS8 is new in 4.3, and makes cbreak mode provide all 8 bits. */ #ifndef LPASS8 #define LPASS8 0 #endif #ifdef BSD4_1 #define LNOFLSH 0100000 #endif static int baud_convert[] = #ifdef BAUD_CONVERT BAUD_CONVERT; #else { 0, 50, 75, 110, 135, 150, 200, 300, 600, 1200, 1800, 2400, 4800, 9600, 19200, 38400 }; #endif extern short ospeed; /* The file descriptor for Emacs's input terminal. Under Unix, this is normaly zero except when using X; under VMS, we place the input channel number here. This allows us to write more code that works for both VMS and Unix. */ static int input_fd; /* Specify a different file descriptor for further input operations. */ void change_input_fd (fd) int fd; { #ifdef VMS /* On VMS, desc will contain a channel number. */ extern unsigned int input_ef; extern VMS_CHAN_STUFF *get_vms_channel_pointer (); VMS_CHAN_STUFF * vs = get_vms_channel_pointer (0); end_kbd_input (); vs->chan = fd; #endif input_fd = fd; } /* Discard pending input on descriptor input_fd. */ /* This is good to know about for VMS */ extern Lisp_Object Vwindow_system; discard_tty_input () { struct emacs_tty buf; if (noninteractive) return; /* Discarding input is not safe when the input could contain replies from the X server. So don't do it. */ if (read_socket_hook) return; #ifdef VMS if (!NILP (Vwindow_system)) return; end_kbd_input (); sys$qiow (0, input_fd, IO$_READVBLK|IO$M_PURGE, &input_iosb, 0, 0, &buf.main, 0, 0, terminator_mask, 0, 0); queue_kbd_input (); #else /* not VMS */ #ifdef APOLLO { int zero = 0; ioctl (input_fd, TIOCFLUSH, &zero); } #else /* not Apollo */ #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */ while (dos_keyread () != -1) ; #else /* not MSDOS */ EMACS_GET_TTY (input_fd, &buf); EMACS_SET_TTY (input_fd, &buf, 0); #endif /* not MSDOS */ #endif /* not Apollo */ #endif /* not VMS */ } #ifdef SIGTSTP /* Arrange for character C to be read as the next input from the terminal. */ stuff_char (c) char c; { /* Should perhaps error if in batch mode */ #ifdef TIOCSTI ioctl (input_fd, TIOCSTI, &c); #else /* no TIOCSTI */ error ("Cannot stuff terminal input characters in this version of Unix"); #endif /* no TIOCSTI */ } #endif /* SIGTSTP */ init_baud_rate () { if (noninteractive) ospeed = 0; else { #ifdef MSDOS ospeed = 15; #else #ifdef VMS struct sensemode sg; if (NILP (Vwindow_system)) sys$qiow (0, input_fd, IO$_SENSEMODE, &sg, 0, 0, &sg.class, 12, 0, 0, 0, 0 ); ospeed = sg.xmit_baud; #else /* not VMS */ #ifdef HAVE_TERMIOS struct termios sg; sg.c_cflag = B9600; tcgetattr (input_fd, &sg); ospeed = cfgetospeed (&sg); #if defined (USE_GETOBAUD) && defined (getobaud) /* m88k-motorola-sysv3 needs this (ghazi@noc.rutgers.edu) 9/1/94. */ if (ospeed == 0) ospeed = getobaud (sg.c_cflag); #endif #else /* neither VMS nor TERMIOS */ #ifdef HAVE_TERMIO struct termio sg; sg.c_cflag = B9600; #ifdef HAVE_TCATTR tcgetattr (input_fd, &sg); #else ioctl (input_fd, TCGETA, &sg); #endif ospeed = sg.c_cflag & CBAUD; #else /* neither VMS nor TERMIOS nor TERMIO */ struct sgttyb sg; sg.sg_ospeed = B9600; if (ioctl (input_fd, TIOCGETP, &sg) < 0) abort (); ospeed = sg.sg_ospeed; #endif /* not HAVE_TERMIO */ #endif /* not HAVE_TERMIOS */ #endif /* not VMS */ #endif /* not MSDOS */ } baud_rate = (ospeed < sizeof baud_convert / sizeof baud_convert[0] ? baud_convert[ospeed] : 9600); if (baud_rate == 0) baud_rate = 1200; } /*ARGSUSED*/ set_exclusive_use (fd) int fd; { #ifdef FIOCLEX ioctl (fd, FIOCLEX, 0); #endif /* Ok to do nothing if this feature does not exist */ } #ifndef subprocesses wait_without_blocking () { #ifdef BSD wait3 (0, WNOHANG | WUNTRACED, 0); #else croak ("wait_without_blocking"); #endif synch_process_alive = 0; } #endif /* not subprocesses */ int wait_debugging; /* Set nonzero to make following function work under dbx (at least for bsd). */ SIGTYPE wait_for_termination_signal () {} #ifndef VMS /* moved to vmsproc.c */ /* Wait for subprocess with process id `pid' to terminate and make sure it will get eliminated (not remain forever as a zombie) */ wait_for_termination (pid) int pid; { while (1) { #ifdef subprocesses #ifdef VMS int status; status = sys$forcex (&pid, 0, 0); break; #else /* not VMS */ #if defined (BSD) || (defined (HPUX) && !defined (HPUX_5)) /* Note that kill returns -1 even if the process is just a zombie now. But inevitably a SIGCHLD interrupt should be generated and child_sig will do wait3 and make the process go away. */ /* There is some indication that there is a bug involved with termination of subprocesses, perhaps involving a kernel bug too, but no idea what it is. Just as a hunch we signal SIGCHLD to see if that causes the problem to go away or get worse. */ sigsetmask (sigmask (SIGCHLD)); if (0 > kill (pid, 0)) { sigsetmask (SIGEMPTYMASK); kill (getpid (), SIGCHLD); break; } if (wait_debugging) sleep (1); else sigpause (SIGEMPTYMASK); #else /* not BSD, and not HPUX version >= 6 */ #if defined (UNIPLUS) if (0 > kill (pid, 0)) break; wait (0); #else /* neither BSD nor UNIPLUS: random sysV */ #ifdef POSIX_SIGNALS /* would this work for LINUX as well? */ sigblock (sigmask (SIGCHLD)); if (0 > kill (pid, 0)) { sigunblock (sigmask (SIGCHLD)); break; } sigpause (SIGEMPTYMASK); #else /* not POSIX_SIGNALS */ #ifdef HAVE_SYSV_SIGPAUSE sighold (SIGCHLD); if (0 > kill (pid, 0)) { sigrelse (SIGCHLD); break; } sigpause (SIGCHLD); #else /* not HAVE_SYSV_SIGPAUSE */ if (0 > kill (pid, 0)) break; /* Using sleep instead of pause avoids timing error. If the inferior dies just before the sleep, we lose just one second. */ sleep (1); #endif /* not HAVE_SYSV_SIGPAUSE */ #endif /* not POSIX_SIGNALS */ #endif /* not UNIPLUS */ #endif /* not BSD, and not HPUX version >= 6 */ #endif /* not VMS */ #else /* not subprocesses */ #ifndef BSD4_1 if (kill (pid, 0) < 0) break; wait (0); #else /* BSD4_1 */ int status; status = wait (0); if (status == pid || status == -1) break; #endif /* BSD4_1 */ #endif /* not subprocesses */ } } #endif /* not VMS */ #ifdef subprocesses /* * flush any pending output * (may flush input as well; it does not matter the way we use it) */ flush_pending_output (channel) int channel; { #ifdef HAVE_TERMIOS /* If we try this, we get hit with SIGTTIN, because the child's tty belongs to the child's pgrp. */ #else #ifdef TCFLSH ioctl (channel, TCFLSH, 1); #else #ifdef TIOCFLUSH int zero = 0; /* 3rd arg should be ignored but some 4.2 kernels actually want the address of an int and nonzero means something different. */ ioctl (channel, TIOCFLUSH, &zero); #endif #endif #endif } #ifndef VMS /* Set up the terminal at the other end of a pseudo-terminal that we will be controlling an inferior through. It should not echo or do line-editing, since that is done in Emacs. No padding needed for insertion into an Emacs buffer. */ child_setup_tty (out) int out; { #ifndef MSDOS struct emacs_tty s; EMACS_GET_TTY (out, &s); #if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS) s.main.c_oflag |= OPOST; /* Enable output postprocessing */ s.main.c_oflag &= ~ONLCR; /* Disable map of NL to CR-NL on output */ #ifdef NLDLY s.main.c_oflag &= ~(NLDLY|CRDLY|TABDLY|BSDLY|VTDLY|FFDLY); /* No output delays */ #endif s.main.c_lflag &= ~ECHO; /* Disable echo */ s.main.c_lflag |= ISIG; /* Enable signals */ #ifdef IUCLC s.main.c_iflag &= ~IUCLC; /* Disable downcasing on input. */ #endif #ifdef OLCUC s.main.c_oflag &= ~OLCUC; /* Disable upcasing on output. */ #endif s.main.c_cflag = (s.main.c_cflag & ~CSIZE) | CS8; /* Don't strip 8th bit */ #if 0 /* Said to be unnecessary: */ s.main.c_cc[VMIN] = 1; /* minimum number of characters to accept */ s.main.c_cc[VTIME] = 0; /* wait forever for at least 1 character */ #endif s.main.c_lflag |= ICANON; /* Enable erase/kill and eof processing */ s.main.c_cc[VEOF] = 04; /* insure that EOF is Control-D */ s.main.c_cc[VERASE] = 0377; /* disable erase processing */ s.main.c_cc[VKILL] = 0377; /* disable kill processing */ #ifdef HPUX s.main.c_cflag = (s.main.c_cflag & ~CBAUD) | B9600; /* baud rate sanity */ #endif /* HPUX */ #ifdef AIX /* AIX enhanced edit loses NULs, so disable it */ #ifndef IBMR2AIX s.main.c_line = 0; s.main.c_iflag &= ~ASCEDIT; #endif /* Also, PTY overloads NUL and BREAK. don't ignore break, but don't signal either, so it looks like NUL. */ s.main.c_iflag &= ~IGNBRK; s.main.c_iflag &= ~BRKINT; /* QUIT and INTR work better as signals, so disable character forms */ s.main.c_cc[VINTR] = 0377; #ifdef SIGNALS_VIA_CHARACTERS /* the QUIT and INTR character are used in process_send_signal so set them here to something useful. */ if (s.main.c_cc[VQUIT] == 0377) s.main.c_cc[VQUIT] = '\\'&037; /* Control-\ */ if (s.main.c_cc[VINTR] == 0377) s.main.c_cc[VINTR] = 'C'&037; /* Control-C */ #else /* no TIOCGPGRP or no TIOCGLTC or no TIOCGETC */ /* QUIT and INTR work better as signals, so disable character forms */ s.main.c_cc[VQUIT] = 0377; s.main.c_cc[VINTR] = 0377; s.main.c_lflag &= ~ISIG; #endif /* no TIOCGPGRP or no TIOCGLTC or no TIOCGETC */ s.main.c_cc[VEOL] = 0377; s.main.c_cflag = (s.main.c_cflag & ~CBAUD) | B9600; /* baud rate sanity */ #endif /* AIX */ #else /* not HAVE_TERMIO */ s.main.sg_flags &= ~(ECHO | CRMOD | ANYP | ALLDELAY | RAW | LCASE | CBREAK | TANDEM); s.main.sg_flags |= LPASS8; s.main.sg_erase = 0377; s.main.sg_kill = 0377; s.lmode = LLITOUT | s.lmode; /* Don't strip 8th bit */ #endif /* not HAVE_TERMIO */ EMACS_SET_TTY (out, &s, 0); #ifdef BSD4_1 if (interrupt_input) reset_sigio (); #endif /* BSD4_1 */ #ifdef RTU { int zero = 0; ioctl (out, FIOASYNC, &zero); } #endif /* RTU */ #endif /* not MSDOS */ } #endif /* not VMS */ #endif /* subprocesses */ /*ARGSUSED*/ setpgrp_of_tty (pid) int pid; { EMACS_SET_TTY_PGRP (input_fd, &pid); } /* Record a signal code and the handler for it. */ struct save_signal { int code; SIGTYPE (*handler) (); }; /* Suspend the Emacs process; give terminal to its superior. */ sys_suspend () { #ifdef VMS /* "Foster" parentage allows emacs to return to a subprocess that attached to the current emacs as a cheaper than starting a whole new process. This is set up by KEPTEDITOR.COM. */ unsigned long parent_id, foster_parent_id; char *fpid_string; fpid_string = getenv ("EMACS_PARENT_PID"); if (fpid_string != NULL) { sscanf (fpid_string, "%x", &foster_parent_id); if (foster_parent_id != 0) parent_id = foster_parent_id; else parent_id = getppid (); } else parent_id = getppid (); xfree (fpid_string); /* On VMS, this was malloc'd */ if (parent_id && parent_id != 0xffffffff) { SIGTYPE (*oldsig)() = (int) signal (SIGINT, SIG_IGN); int status = lib$attach (&parent_id) & 1; signal (SIGINT, oldsig); return status; } else { struct { int l; char *a; } d_prompt; d_prompt.l = sizeof ("Emacs: "); /* Our special prompt */ d_prompt.a = "Emacs: "; /* Just a reminder */ lib$spawn (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, &d_prompt, 0); return 1; } return -1; #else #if defined(SIGTSTP) && !defined(MSDOS) { int pgrp = EMACS_GETPGRP (0); EMACS_KILLPG (pgrp, SIGTSTP); } #else /* No SIGTSTP */ #ifdef USG_JOBCTRL /* If you don't know what this is don't mess with it */ ptrace (0, 0, 0, 0); /* set for ptrace - caught by csh */ kill (getpid (), SIGQUIT); #else /* No SIGTSTP or USG_JOBCTRL */ /* On a system where suspending is not implemented, instead fork a subshell and let it talk directly to the terminal while we wait. */ sys_subshell (); #endif /* no USG_JOBCTRL */ #endif /* no SIGTSTP */ #endif /* not VMS */ } /* Fork a subshell. */ sys_subshell () { #ifndef VMS #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida */ int st; char oldwd[MAXPATHLEN+1]; /* Fixed length is safe on MSDOS. */ #endif int pid; struct save_signal saved_handlers[5]; Lisp_Object dir; unsigned char *str = 0; int len; saved_handlers[0].code = SIGINT; saved_handlers[1].code = SIGQUIT; saved_handlers[2].code = SIGTERM; #ifdef SIGIO saved_handlers[3].code = SIGIO; saved_handlers[4].code = 0; #else saved_handlers[3].code = 0; #endif /* Mentioning current_buffer->buffer would mean including buffer.h, which somehow wedges the hp compiler. So instead... */ dir = intern ("default-directory"); /* Can't use NILP */ if (XFASTINT (Fboundp (dir)) == XFASTINT (Qnil)) goto xyzzy; dir = Fsymbol_value (dir); if (XTYPE (dir) != Lisp_String) goto xyzzy; dir = expand_and_dir_to_file (Funhandled_file_name_directory (dir), Qnil); str = (unsigned char *) alloca (XSTRING (dir)->size + 2); len = XSTRING (dir)->size; bcopy (XSTRING (dir)->data, str, len); if (str[len - 1] != '/') str[len++] = '/'; str[len] = 0; xyzzy: pid = vfork (); if (pid == -1) error ("Can't spawn subshell"); if (pid == 0) { char *sh; #ifdef MSDOS /* MW, Aug 1993 */ getwd (oldwd); #endif sh = (char *) egetenv ("SHELL"); if (sh == 0) sh = "sh"; /* Use our buffer's default directory for the subshell. */ if (str) chdir (str); #ifdef subprocesses close_process_descs (); /* Close Emacs's pipes/ptys */ #endif #ifdef SET_EMACS_PRIORITY { extern int emacs_priority; if (emacs_priority < 0) nice (-emacs_priority); } #endif #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida */ st = system (sh); chdir (oldwd); if (st) report_file_error ("Can't execute subshell", Fcons (build_string (sh), Qnil)); #else /* not MSDOS */ execlp (sh, sh, 0); write (1, "Can't execute subshell", 22); _exit (1); #endif /* not MSDOS */ } save_signal_handlers (saved_handlers); synch_process_alive = 1; wait_for_termination (pid); restore_signal_handlers (saved_handlers); #endif /* !VMS */ } save_signal_handlers (saved_handlers) struct save_signal *saved_handlers; { while (saved_handlers->code) { saved_handlers->handler = (SIGTYPE (*) ()) signal (saved_handlers->code, SIG_IGN); saved_handlers++; } } restore_signal_handlers (saved_handlers) struct save_signal *saved_handlers; { while (saved_handlers->code) { signal (saved_handlers->code, saved_handlers->handler); saved_handlers++; } } #ifdef F_SETFL int old_fcntl_flags; init_sigio () { #ifdef FASYNC old_fcntl_flags = fcntl (input_fd, F_GETFL, 0) & ~FASYNC; #endif request_sigio (); } reset_sigio () { unrequest_sigio (); } #ifdef FASYNC /* F_SETFL does not imply existence of FASYNC */ request_sigio () { #ifdef SIGWINCH sigunblock (sigmask (SIGWINCH)); #endif fcntl (input_fd, F_SETFL, old_fcntl_flags | FASYNC); interrupts_deferred = 0; } unrequest_sigio () { #ifdef SIGWINCH sigblock (sigmask (SIGWINCH)); #endif fcntl (input_fd, F_SETFL, old_fcntl_flags); interrupts_deferred = 1; } #else /* no FASYNC */ #ifdef STRIDE /* Stride doesn't have FASYNC - use FIOASYNC */ request_sigio () { int on = 1; ioctl (input_fd, FIOASYNC, &on); interrupts_deferred = 0; } unrequest_sigio () { int off = 0; ioctl (input_fd, FIOASYNC, &off); interrupts_deferred = 1; } #else /* not FASYNC, not STRIDE */ #ifdef _CX_UX #include request_sigio () { int on = 1; sigset_t st; sigemptyset(&st); sigaddset(&st, SIGIO); ioctl (input_fd, FIOASYNC, &on); interrupts_deferred = 0; sigprocmask(SIG_UNBLOCK, &st, (sigset_t *)0); } unrequest_sigio () { int off = 0; ioctl (input_fd, FIOASYNC, &off); interrupts_deferred = 1; } #else /* ! _CX_UX */ request_sigio () { croak ("request_sigio"); } unrequest_sigio () { croak ("unrequest_sigio"); } #endif /* _CX_UX */ #endif /* STRIDE */ #endif /* FASYNC */ #endif /* F_SETFL */ /* Saving and restoring the process group of Emacs's terminal. */ #ifdef BSD_PGRPS /* The process group of which Emacs was a member when it initially started. If Emacs was in its own process group (i.e. inherited_pgroup == getpid ()), then we know we're running under a shell with job control (Emacs would never be run as part of a pipeline). Everything is fine. If Emacs was not in its own process group, then we know we're running under a shell (or a caller) that doesn't know how to separate itself from Emacs (like sh). Emacs must be in its own process group in order to receive SIGIO correctly. In this situation, we put ourselves in our own pgroup, forcibly set the tty's pgroup to our pgroup, and make sure to restore and reinstate the tty's pgroup just like any other terminal setting. If inherited_group was not the tty's pgroup, then we'll get a SIGTTmumble when we try to change the tty's pgroup, and a CONT if it goes foreground in the future, which is what should happen. */ int inherited_pgroup; /* Split off the foreground process group to Emacs alone. When we are in the foreground, but not started in our own process group, redirect the TTY to point to our own process group. We need to be in our own process group to receive SIGIO properly. */ narrow_foreground_group () { int me = getpid (); setpgrp (0, inherited_pgroup); if (inherited_pgroup != me) EMACS_SET_TTY_PGRP (input_fd, &me); setpgrp (0, me); } /* Set the tty to our original foreground group. */ widen_foreground_group () { if (inherited_pgroup != getpid ()) EMACS_SET_TTY_PGRP (input_fd, &inherited_pgroup); setpgrp (0, inherited_pgroup); } #endif /* BSD_PGRPS */ /* Getting and setting emacs_tty structures. */ /* Set *TC to the parameters associated with the terminal FD. Return zero if all's well, or -1 if we ran into an error we couldn't deal with. */ int emacs_get_tty (fd, settings) int fd; struct emacs_tty *settings; { /* Retrieve the primary parameters - baud rate, character size, etcetera. */ #ifdef HAVE_TCATTR /* We have those nifty POSIX tcmumbleattr functions. */ if (tcgetattr (fd, &settings->main) < 0) return -1; #else #ifdef HAVE_TERMIO /* The SYSV-style interface? */ if (ioctl (fd, TCGETA, &settings->main) < 0) return -1; #else #ifdef VMS /* Vehemently Monstrous System? :-) */ if (! (sys$qiow (0, fd, IO$_SENSEMODE, settings, 0, 0, &settings->main.class, 12, 0, 0, 0, 0) & 1)) return -1; #else #ifndef MSDOS /* I give up - I hope you have the BSD ioctls. */ if (ioctl (fd, TIOCGETP, &settings->main) < 0) return -1; #endif /* not MSDOS */ #endif #endif #endif /* Suivant - Do we have to get struct ltchars data? */ #ifdef HAVE_LTCHARS if (ioctl (fd, TIOCGLTC, &settings->ltchars) < 0) return -1; #endif /* How about a struct tchars and a wordful of lmode bits? */ #ifdef HAVE_TCHARS if (ioctl (fd, TIOCGETC, &settings->tchars) < 0 || ioctl (fd, TIOCLGET, &settings->lmode) < 0) return -1; #endif /* We have survived the tempest. */ return 0; } /* Set the parameters of the tty on FD according to the contents of *SETTINGS. If WAITP is non-zero, we wait for all queued output to be written before making the change; otherwise, we forget any queued input and make the change immediately. Return 0 if all went well, and -1 if anything failed. */ int emacs_set_tty (fd, settings, waitp) int fd; struct emacs_tty *settings; int waitp; { /* Set the primary parameters - baud rate, character size, etcetera. */ #ifdef HAVE_TCATTR int i; /* We have those nifty POSIX tcmumbleattr functions. William J. Smith writes: "POSIX 1003.1 defines tcsetattr() to return success if it was able to perform any of the requested actions, even if some of the requested actions could not be performed. We must read settings back to ensure tty setup properly. AIX requires this to keep tty from hanging occasionally." */ /* This make sure that we don't loop indefinitely in here. */ for (i = 0 ; i < 10 ; i++) if (tcsetattr (fd, waitp ? TCSAFLUSH : TCSADRAIN, &settings->main) < 0) { if (errno == EINTR) continue; else return -1; } else { struct termios new; /* Get the current settings, and see if they're what we asked for. */ tcgetattr (fd, &new); /* We cannot use memcmp on the whole structure here because under * aix386 the termios structure has some reserved field that may * not be filled in. */ if ( new.c_iflag == settings->main.c_iflag && new.c_oflag == settings->main.c_oflag && new.c_cflag == settings->main.c_cflag && new.c_lflag == settings->main.c_lflag && memcmp(new.c_cc, settings->main.c_cc, NCCS) == 0) break; else continue; } #else #ifdef HAVE_TERMIO /* The SYSV-style interface? */ if (ioctl (fd, waitp ? TCSETAW : TCSETAF, &settings->main) < 0) return -1; #else #ifdef VMS /* Vehemently Monstrous System? :-) */ if (! (sys$qiow (0, fd, IO$_SETMODE, settings, 0, 0, &settings->main.class, 12, 0, 0, 0, 0) & 1)) return -1; #else #ifndef MSDOS /* I give up - I hope you have the BSD ioctls. */ if (ioctl (fd, (waitp) ? TIOCSETP : TIOCSETN, &settings->main) < 0) return -1; #endif /* not MSDOS */ #endif #endif #endif /* Suivant - Do we have to get struct ltchars data? */ #ifdef HAVE_LTCHARS if (ioctl (fd, TIOCSLTC, &settings->ltchars) < 0) return -1; #endif /* How about a struct tchars and a wordful of lmode bits? */ #ifdef HAVE_TCHARS if (ioctl (fd, TIOCSETC, &settings->tchars) < 0 || ioctl (fd, TIOCLSET, &settings->lmode) < 0) return -1; #endif /* We have survived the tempest. */ return 0; } /* The initial tty mode bits */ struct emacs_tty old_tty; int term_initted; /* 1 if outer tty status has been recorded */ #ifdef BSD4_1 /* BSD 4.1 needs to keep track of the lmode bits in order to start sigio. */ int lmode; #endif #ifndef F_SETOWN_BUG #ifdef F_SETOWN int old_fcntl_owner; #endif /* F_SETOWN */ #endif /* F_SETOWN_BUG */ /* This may also be defined in stdio, but if so, this does no harm, and using the same name avoids wasting the other one's space. */ #if defined (USG) || defined (DGUX) unsigned char _sobuf[BUFSIZ+8]; #else char _sobuf[BUFSIZ]; #endif #ifdef HAVE_LTCHARS static struct ltchars new_ltchars = {-1,-1,-1,-1,-1,-1}; #endif #ifdef HAVE_TCHARS static struct tchars new_tchars = {-1,-1,-1,-1,-1,-1}; #endif #ifdef VMS unsigned int input_ef = 0; unsigned int input_eflist = 0; unsigned int timer_ef = 0; unsigned int timer_eflist = 0; unsigned int process_ef = 0; unsigned int stop_input = 0; unsigned int ast_queued = 0; #endif init_sys_modes () { struct emacs_tty tty; #ifdef VMS #if 0 static int oob_chars[2] = {0, 1 << 7}; /* catch C-g's */ extern int (*interrupt_signal) (); #endif #endif if (noninteractive) return; #ifdef VMS if (!input_ef) input_ef = get_kbd_event_flag (); /* lib$get_ef (&input_ef); */ sys$clref (input_ef); #if 0 waiting_for_ast = 0; #endif if (!timer_ef) timer_ef = get_timer_event_flag (); /* lib$get_ef (&timer_ef); */ sys$clref (timer_ef); #if 0 if (!process_ef) { lib$get_ef (&process_ef); sys$clref (process_ef); } if (input_ef / 32 != process_ef / 32) croak ("Input and process event flags in different clusters."); #endif if (input_ef / 32 != timer_ef / 32) croak ("Input and timer event flags in different clusters."); #if 0 input_eflist = ((unsigned) 1 << (input_ef % 32)) | ((unsigned) 1 << (process_ef % 32)); #endif timer_eflist = ((unsigned) 1 << (input_ef % 32)) | ((unsigned) 1 << (timer_ef % 32)); #ifndef VMS4_4 sys_access_reinit (); #endif #endif /* not VMS */ #ifdef BSD_PGRPS if (! read_socket_hook && EQ (Vwindow_system, Qnil)) narrow_foreground_group (); #endif #ifdef VMS if (NILP (Vwindow_system)) #endif EMACS_GET_TTY (input_fd, &old_tty); if (!read_socket_hook && EQ (Vwindow_system, Qnil)) { tty = old_tty; #if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS) #ifdef DGUX /* This allows meta to be sent on 8th bit. */ tty.main.c_iflag &= ~INPCK; /* don't check input for parity */ #endif tty.main.c_iflag |= (IGNBRK); /* Ignore break condition */ tty.main.c_iflag &= ~ICRNL; /* Disable map of CR to NL on input */ #ifdef ISTRIP tty.main.c_iflag &= ~ISTRIP; /* don't strip 8th bit on input */ #endif tty.main.c_lflag &= ~ECHO; /* Disable echo */ tty.main.c_lflag &= ~ICANON; /* Disable erase/kill processing */ #ifdef IEXTEN tty.main.c_lflag &= ~IEXTEN; /* Disable other editing characters. */ #endif tty.main.c_lflag |= ISIG; /* Enable signals */ if (flow_control) { tty.main.c_iflag |= IXON; /* Enable start/stop output control */ #ifdef IXANY tty.main.c_iflag &= ~IXANY; #endif /* IXANY */ } else tty.main.c_iflag &= ~IXON; /* Disable start/stop output control */ tty.main.c_oflag &= ~ONLCR; /* Disable map of NL to CR-NL on output */ tty.main.c_oflag &= ~TAB3; /* Disable tab expansion */ #ifdef CS8 if (meta_key) { tty.main.c_cflag |= CS8; /* allow 8th bit on input */ tty.main.c_cflag &= ~PARENB;/* Don't check parity */ } #endif tty.main.c_cc[VINTR] = quit_char; /* C-g (usually) gives SIGINT */ /* Set up C-g for both SIGQUIT and SIGINT. We don't know which we will get, but we handle both alike so which one it really gives us does not matter. */ tty.main.c_cc[VQUIT] = quit_char; tty.main.c_cc[VMIN] = 1; /* Input should wait for at least 1 char */ tty.main.c_cc[VTIME] = 0; /* no matter how long that takes. */ #ifdef VSWTCH tty.main.c_cc[VSWTCH] = CDISABLE; /* Turn off shell layering use of C-z */ #endif /* VSWTCH */ #if defined (mips) || defined (HAVE_TCATTR) #ifdef VSUSP tty.main.c_cc[VSUSP] = CDISABLE; /* Turn off mips handling of C-z. */ #endif /* VSUSP */ #ifdef V_DSUSP tty.main.c_cc[V_DSUSP] = CDISABLE; /* Turn off mips handling of C-y. */ #endif /* V_DSUSP */ #ifdef VDSUSP /* Some systems have VDSUSP, some have V_DSUSP. */ tty.main.c_cc[VDSUSP] = CDISABLE; #endif /* VDSUSP */ #ifdef VLNEXT tty.main.c_cc[VLNEXT] = CDISABLE; #endif /* VLNEXT */ #ifdef VREPRINT tty.main.c_cc[VREPRINT] = CDISABLE; #endif /* VREPRINT */ #ifdef VWERASE tty.main.c_cc[VWERASE] = CDISABLE; #endif /* VWERASE */ #ifdef VDISCARD tty.main.c_cc[VDISCARD] = CDISABLE; #endif /* VDISCARD */ #ifdef VSTART tty.main.c_cc[VSTART] = CDISABLE; #endif /* VSTART */ #ifdef VSTOP tty.main.c_cc[VSTOP] = CDISABLE; #endif /* VSTOP */ #endif /* mips or HAVE_TCATTR */ #ifdef AIX #ifndef IBMR2AIX /* AIX enhanced edit loses NULs, so disable it */ tty.main.c_line = 0; tty.main.c_iflag &= ~ASCEDIT; #else tty.main.c_cc[VSTRT] = 255; tty.main.c_cc[VSTOP] = 255; tty.main.c_cc[VSUSP] = 255; tty.main.c_cc[VDSUSP] = 255; #endif /* IBMR2AIX */ /* Also, PTY overloads NUL and BREAK. don't ignore break, but don't signal either, so it looks like NUL. This really serves a purpose only if running in an XTERM window or via TELNET or the like, but does no harm elsewhere. */ tty.main.c_iflag &= ~IGNBRK; tty.main.c_iflag &= ~BRKINT; #endif #else /* if not HAVE_TERMIO */ #ifdef VMS tty.main.tt_char |= TT$M_NOECHO; if (meta_key) tty.main.tt_char |= TT$M_EIGHTBIT; if (flow_control) tty.main.tt_char |= TT$M_TTSYNC; else tty.main.tt_char &= ~TT$M_TTSYNC; tty.main.tt2_char |= TT2$M_PASTHRU | TT2$M_XON; #else /* not VMS (BSD, that is) */ #ifndef MSDOS tty.main.sg_flags &= ~(ECHO | CRMOD | XTABS); if (meta_key) tty.main.sg_flags |= ANYP; tty.main.sg_flags |= interrupt_input ? RAW : CBREAK; #endif #endif /* not VMS (BSD, that is) */ #endif /* not HAVE_TERMIO */ /* If going to use CBREAK mode, we must request C-g to interrupt and turn off start and stop chars, etc. If not going to use CBREAK mode, do this anyway so as to turn off local flow control for user coming over network on 4.2; in this case, only t_stopc and t_startc really matter. */ #ifndef HAVE_TERMIO #ifdef HAVE_TCHARS /* Note: if not using CBREAK mode, it makes no difference how we set this */ tty.tchars = new_tchars; tty.tchars.t_intrc = quit_char; if (flow_control) { tty.tchars.t_startc = '\021'; tty.tchars.t_stopc = '\023'; } tty.lmode = LDECCTQ | LLITOUT | LPASS8 | LNOFLSH | old_tty.lmode; #ifdef ultrix /* Under Ultrix 4.2a, leaving this out doesn't seem to hurt anything, and leaving it in breaks the meta key. Go figure. */ tty.lmode &= ~LLITOUT; #endif #ifdef BSD4_1 lmode = tty.lmode; #endif #endif /* HAVE_TCHARS */ #endif /* not HAVE_TERMIO */ #ifdef HAVE_LTCHARS tty.ltchars = new_ltchars; #endif /* HAVE_LTCHARS */ #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida, MW Aug 1993 */ internal_terminal_init (); dos_ttraw (); #endif EMACS_SET_TTY (input_fd, &tty, 0); /* This code added to insure that, if flow-control is not to be used, we have an unlocked terminal at the start. */ #ifdef TCXONC if (!flow_control) ioctl (input_fd, TCXONC, 1); #endif #ifndef APOLLO #ifdef TIOCSTART if (!flow_control) ioctl (input_fd, TIOCSTART, 0); #endif #endif #ifdef AIX hft_init (); #ifdef IBMR2AIX { /* IBM's HFT device usually thinks a ^J should be LF/CR. We need it to be only LF. This is the way that is done. */ struct termio tty; if (ioctl (1, HFTGETID, &tty) != -1) write (1, "\033[20l", 5); } #endif #endif #ifdef VMS /* Appears to do nothing when in PASTHRU mode. sys$qiow (0, input_fd, IO$_SETMODE|IO$M_OUTBAND, 0, 0, 0, interrupt_signal, oob_chars, 0, 0, 0, 0); */ queue_kbd_input (0); #endif /* VMS */ } #ifdef F_SETFL #ifndef F_SETOWN_BUG #ifdef F_GETOWN /* F_SETFL does not imply existence of F_GETOWN */ if (interrupt_input && ! read_socket_hook && EQ (Vwindow_system, Qnil)) { old_fcntl_owner = fcntl (input_fd, F_GETOWN, 0); fcntl (input_fd, F_SETOWN, getpid ()); init_sigio (); } #endif /* F_GETOWN */ #endif /* F_SETOWN_BUG */ #endif /* F_SETFL */ #ifdef BSD4_1 if (interrupt_input) init_sigio (); #endif #ifdef VMS /* VMS sometimes has this symbol but lacks setvbuf. */ #undef _IOFBF #endif #ifdef _IOFBF /* This symbol is defined on recent USG systems. Someone says without this call USG won't really buffer the file even with a call to setbuf. */ setvbuf (stdout, _sobuf, _IOFBF, sizeof _sobuf); #else setbuf (stdout, _sobuf); #endif if (! read_socket_hook && EQ (Vwindow_system, Qnil)) set_terminal_modes (); if (term_initted && no_redraw_on_reenter) { if (display_completed) direct_output_forward_char (0); } else { frame_garbaged = 1; #ifdef MULTI_FRAME if (FRAMEP (Vterminal_frame)) FRAME_GARBAGED_P (XFRAME (Vterminal_frame)) = 1; #endif } term_initted = 1; } /* Return nonzero if safe to use tabs in output. At the time this is called, init_sys_modes has not been done yet. */ tabs_safe_p () { struct emacs_tty tty; #ifdef VMS if (!NILP (Vwindow_system)) return 1; #endif EMACS_GET_TTY (input_fd, &tty); return EMACS_TTY_TABS_OK (&tty); } /* Get terminal size from system. Store number of lines into *HEIGHTP and width into *WIDTHP. We store 0 if there's no valid information. */ get_frame_size (widthp, heightp) int *widthp, *heightp; { #ifdef TIOCGWINSZ /* BSD-style. */ struct winsize size; if (ioctl (input_fd, TIOCGWINSZ, &size) == -1) *widthp = *heightp = 0; else { *widthp = size.ws_col; *heightp = size.ws_row; } #else #ifdef TIOCGSIZE /* SunOS - style. */ struct ttysize size; if (ioctl (input_fd, TIOCGSIZE, &size) == -1) *widthp = *heightp = 0; else { *widthp = size.ts_cols; *heightp = size.ts_lines; } #else #ifdef VMS struct sensemode tty; sys$qiow (0, input_fd, IO$_SENSEMODE, &tty, 0, 0, &tty.class, 12, 0, 0, 0, 0); *widthp = tty.scr_wid; *heightp = tty.scr_len; #else #ifdef MSDOS *widthp = ScreenCols (); *heightp = ScreenRows (); #else /* system doesn't know size */ *widthp = 0; *heightp = 0; #endif #endif /* not VMS */ #endif /* not SunOS-style */ #endif /* not BSD-style */ } /* Set the logical window size associated with descriptor FD to HEIGHT and WIDTH. This is used mainly with ptys. */ int set_window_size (fd, height, width) int fd, height, width; { #ifdef TIOCSWINSZ /* BSD-style. */ struct winsize size; size.ws_row = height; size.ws_col = width; if (ioctl (fd, TIOCSWINSZ, &size) == -1) return 0; /* error */ else return 1; #else #ifdef TIOCSSIZE /* SunOS - style. */ struct ttysize size; size.ts_lines = height; size.ts_cols = width; if (ioctl (fd, TIOCGSIZE, &size) == -1) return 0; else return 1; #else return -1; #endif /* not SunOS-style */ #endif /* not BSD-style */ } /* Prepare the terminal for exiting Emacs; move the cursor to the bottom of the frame, turn off interrupt-driven I/O, etc. */ reset_sys_modes () { if (noninteractive) { fflush (stdout); return; } if (!term_initted) return; if (read_socket_hook || !EQ (Vwindow_system, Qnil)) return; cursor_to (FRAME_HEIGHT (selected_frame) - 1, 0); clear_end_of_line (FRAME_WIDTH (selected_frame)); /* clear_end_of_line may move the cursor */ cursor_to (FRAME_HEIGHT (selected_frame) - 1, 0); #ifdef IBMR2AIX { /* HFT devices normally use ^J as a LF/CR. We forced it to do the LF only. Now, we need to reset it. */ struct termio tty; if (ioctl (1, HFTGETID, &tty) != -1) write (1, "\033[20h", 5); } #endif reset_terminal_modes (); fflush (stdout); #ifdef BSD #ifndef BSD4_1 /* Avoid possible loss of output when changing terminal modes. */ fsync (fileno (stdout)); #endif #endif #ifdef F_SETFL #ifndef F_SETOWN_BUG #ifdef F_SETOWN /* F_SETFL does not imply existence of F_SETOWN */ if (interrupt_input) { reset_sigio (); fcntl (input_fd, F_SETOWN, old_fcntl_owner); } #endif /* F_SETOWN */ #endif /* F_SETOWN_BUG */ #ifdef O_NDELAY fcntl (input_fd, F_SETFL, fcntl (input_fd, F_GETFL, 0) & ~O_NDELAY); #endif #endif /* F_SETFL */ #ifdef BSD4_1 if (interrupt_input) reset_sigio (); #endif /* BSD4_1 */ #ifdef VMS end_kbd_input (); /* We need this, otherwise the AST will hang on after exit, and prevent the user to get back to the DCL prompt. --- Richard Levitte */ #endif while (EMACS_SET_TTY (input_fd, &old_tty, 0) < 0 && errno == EINTR) ; #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida */ dos_ttcooked (); #endif #ifdef AIX hft_reset (); #endif #ifdef BSD_PGRPS widen_foreground_group (); #endif } #ifdef HAVE_PTYS /* Set up the proper status flags for use of a pty. */ setup_pty (fd) int fd; { /* I'm told that TOICREMOTE does not mean control chars "can't be sent" but rather that they don't have input-editing or signaling effects. That should be good, because we have other ways to do those things in Emacs. However, telnet mode seems not to work on 4.2. So TIOCREMOTE is turned off now. */ /* Under hp-ux, if TIOCREMOTE is turned on, some calls will hang. In particular, the "timeout" feature (which causes a read to return if there is no data available) does this. Also it is known that telnet mode will hang in such a way that Emacs must be stopped (perhaps this is the same problem). If TIOCREMOTE is turned off, then there is a bug in hp-ux which sometimes loses data. Apparently the code which blocks the master process when the internal buffer fills up does not work. Other than this, though, everything else seems to work fine. Since the latter lossage is more benign, we may as well lose that way. -- cph */ #ifdef FIONBIO #ifdef SYSV_PTYS { int on = 1; ioctl (fd, FIONBIO, &on); } #endif #endif #ifdef IBMRTAIX /* On AIX, the parent gets SIGHUP when a pty attached child dies. So, we */ /* ignore SIGHUP once we've started a child on a pty. Note that this may */ /* cause EMACS not to die when it should, i.e., when its own controlling */ /* tty goes away. I've complained to the AIX developers, and they may */ /* change this behavior, but I'm not going to hold my breath. */ signal (SIGHUP, SIG_IGN); #endif } #endif /* HAVE_PTYS */ #ifdef VMS /* Assigning an input channel is done at the start of Emacs execution. This is called each time Emacs is resumed, also, but does nothing because input_chain is no longer zero. */ init_vms_input () { int status; if (input_fd == 0) { status = sys$assign (&input_dsc, &input_fd, 0, 0); if (! (status & 1)) lib$stop (status); } } /* Deassigning the input channel is done before exiting. */ stop_vms_input () { return sys$dassgn (input_fd); } short input_buffer; /* Request reading one character into the keyboard buffer. This is done as soon as the buffer becomes empty. */ queue_kbd_input () { int status; extern kbd_input_ast (); #if 0 waiting_for_ast = 0; #endif stop_input = 0; status = sys$qio (0, input_fd, IO$_READVBLK, &input_iosb, kbd_input_ast, 1, &input_buffer, 1, 0, terminator_mask, 0, 0); ast_queued = 1; } int input_count; /* Ast routine that is called when keyboard input comes in in accord with the sys$qio above. */ #ifdef ASTDEBUG #include "xterm.h" #endif kbd_input_ast () { int old_errno = errno; ast_queued = 0; if (! stop_input) { extern EMACS_TIME *input_available_clear_time; static struct input_event buf[4096]; register int passes = -1; if (input_available_clear_time) EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0); #ifdef ASTDEBUG fprintf (stderr, "ASTDEBUG: AST occured!\n"); #endif while (1) { register int c = -1; register int nread = 0; int i; passes++; if (read_socket_hook) nread = (*read_socket_hook) (0, buf, 4096, 0, 0); else { #if 0 if (interrupt_input_blocked) { interrupt_input_pending = 1; return -1; } interrupt_input_pending = 0; #endif if (passes == 0) { #ifdef ASTDEBUG input_count++; if (input_count == 25) exit (1); printf ("Ast # %d,", input_count); printf (" iosb = %x, %x, %x, %x", input_iosb.offset, input_iosb.status, input_iosb.termlen, input_iosb.term); #endif if (input_iosb.offset) { c = input_buffer; #ifdef ASTDEBUG printf (", char = 0%o", c); #endif } #ifdef ASTDEBUG printf ("\n"); fflush (stdout); sleep (1); #endif queue_kbd_input (); } if (c >= 0) { extern int meta_key; /* in keyboard.c */ nread = 1; buf->kind = ascii_keystroke; buf->modifiers = 0; if (meta_key == 1 && (c & 0x80)) buf->modifiers = meta_modifier; if (meta_key != 2) c &= ~0x80; XSET (buf->code, Lisp_Int, c); #ifdef MULTI_FRAME XSET (buf->frame_or_window, Lisp_Frame, selected_frame); #else buf->frame_or_window = Qnil; #endif } } /* Scan the chars for C-g and store them in kbd_buffer. */ for (i = 0; i < nread; i++) { #ifdef ASTDEBUG { extern Lisp_Object Qexternal_debugging_output; switch (buf[i].kind) { case no_event: fprintf (stderr, "ASTDEBUG: buf[%d] = no event\n", i); break; case ascii_keystroke: fprintf (stderr, "ASTDEBUG: buf[%d] = ASCII keystroke with\n", i); fprintf (stderr, " .code = "); Fprin1 (buf[i].code, Qexternal_debugging_output); fprintf (stderr, "\n"); fprintf (stderr, " .frame_or_window = "); Fprin1 (buf[i].frame_or_window, Qexternal_debugging_output); fprintf (stderr, "\n"); fprintf (stderr, " .timestamp = %d\n", buf[i].timestamp); break; case non_ascii_keystroke: fprintf (stderr, "ASTDEBUG: buf[%d] = keystroke with\n", i); fprintf (stderr, " .code = "); Fprin1 (buf[i].code, Qexternal_debugging_output); fprintf (stderr, "\n"); fprintf (stderr, " .modifiers = %d\n", buf[i].modifiers); fprintf (stderr, " .frame_or_window = "); Fprin1 (buf[i].frame_or_window, Qexternal_debugging_output); fprintf (stderr, "\n"); fprintf (stderr, " .timestamp = %d\n", buf[i].timestamp); break; case mouse_click: fprintf (stderr, "ASTDEBUG: buf[%d] = mouse click with\n", i); fprintf (stderr, " .code = "); Fprin1 (buf[i].code, Qexternal_debugging_output); fprintf (stderr, "\n"); fprintf (stderr, " .modifiers = %d\n", buf[i].modifiers); fprintf (stderr, " .frame_or_window = "); Fprin1 (buf[i].frame_or_window, Qexternal_debugging_output); fprintf (stderr, "\n"); fprintf (stderr, " .x = "); Fprin1 (buf[i].x, Qexternal_debugging_output); fprintf (stderr, "\n"); fprintf (stderr, " .y = "); Fprin1 (buf[i].y, Qexternal_debugging_output); fprintf (stderr, "\n"); fprintf (stderr, " .timestamp = %d\n", buf[i].timestamp); break; case scroll_bar_click: fprintf (stderr, "ASTDEBUG: buf[%d] = mouse click with\n", i); fprintf (stderr, " .code = "); Fprin1 (buf[i].code, Qexternal_debugging_output); fprintf (stderr, "\n"); fprintf (stderr, " .modifiers = %d\n", buf[i].modifiers); fprintf (stderr, " .part = "); switch (buf[i].part) { case scroll_bar_above_handle: fprintf (stderr, "scroll_bar_above_handle\n"); break; case scroll_bar_handle: fprintf (stderr, "scroll_bar_handle\n"); break; case scroll_bar_below_handle: fprintf (stderr, "scroll_bar_below_handle\n"); break; } fprintf (stderr, " .frame_or_window = "); Fprin1 (buf[i].frame_or_window, Qexternal_debugging_output); fprintf (stderr, "\n"); fprintf (stderr, " .x = "); Fprin1 (buf[i].x, Qexternal_debugging_output); fprintf (stderr, "\n"); fprintf (stderr, " .y = "); Fprin1 (buf[i].y, Qexternal_debugging_output); fprintf (stderr, "\n"); fprintf (stderr, " .timestamp = %d\n", buf[i].timestamp); break; case selection_request_event: fprintf (stderr, "ASTDEBUG: buf[%d] = selection request event with\n", i); fprintf (stderr, " .requestor = %u\n", SELECTION_EVENT_REQUESTOR (&buf[i])); fprintf (stderr, " .selection = %u\n", SELECTION_EVENT_SELECTION (&buf[i])); fprintf (stderr, " .target = %u\n", SELECTION_EVENT_TARGET (&buf[i])); fprintf (stderr, " .property = %u\n", SELECTION_EVENT_PROPERTY (&buf[i])); fprintf (stderr, " .time = %u\n", SELECTION_EVENT_TIME (&buf[i])); break; case selection_clear_event: fprintf (stderr, "ASTDEBUG: buf[%d] = selection clear event with\n", i); fprintf (stderr, " .requestor = %u\n", SELECTION_EVENT_REQUESTOR (&buf[i])); fprintf (stderr, " .selection = %u\n", SELECTION_EVENT_SELECTION (&buf[i])); fprintf (stderr, " .target = %u\n", SELECTION_EVENT_TARGET (&buf[i])); fprintf (stderr, " .property = %u\n", SELECTION_EVENT_PROPERTY (&buf[i])); fprintf (stderr, " .time = %u\n", SELECTION_EVENT_TIME (&buf[i])); break; case delete_window_event: fprintf (stderr, "ASTDEBUG: buf[%d] = delete window event with\n", i); fprintf (stderr, " .frame_or_window = "); Fprin1 (buf[i].frame_or_window, Qexternal_debugging_output); break; default: fprintf (stderr, "ASTDEBUG: buf[%d] = some odd event with\n", i); } } #endif kbd_buffer_store_event (&buf[i]); /* Don't look at input that follows a C-g too closely. This reduces lossage due to autorepeat on C-g. */ if (buf[i].kind == ascii_keystroke && XINT(buf[i].code) == quit_char) break; } if (nread <= 0) break; } } { #ifdef ASTDEBUG fprintf (stderr, "ASTDEBUG: setting the event flag %d\n", input_ef); #endif sys$setef (input_ef); } errno = old_errno; } /* Wait until there is something in kbd_buffer. */ #if 0 /* I don't think this is needed */ wait_for_kbd_input () { extern int have_process_input, process_exited; /* If already something, avoid doing system calls. */ if (detect_input_pending ()) { return; } /* Clear a flag, and tell ast routine above to set it. */ sys$clref (input_ef); waiting_for_ast = 1; /* Check for timing error: ast happened while we were doing that. */ if (!detect_input_pending ()) { /* No timing error: wait for flag to be set. */ set_waiting_for_input (0); sys$wflor (input_ef, input_eflist); clear_waiting_for_input (0); if (!detect_input_pending ()) /* Check for subprocess input availability */ { int dsp = have_process_input || process_exited; sys$clref (process_ef); if (have_process_input) process_command_input (); if (process_exited) process_exit (); if (dsp) { update_mode_lines++; prepare_menu_bars (); redisplay_preserve_echo_area (); } } } waiting_for_ast = 0; } #endif /* Get rid of any pending QIO, when we are about to suspend or when we want to throw away pending input. We wait for a positive sign that the AST routine has run and therefore there is no I/O request queued when we return. sys$setast is used to avoid a timing error. */ end_kbd_input () { #ifdef ASTDEBUG printf ("At end_kbd_input.\n"); fflush (stdout); sleep (1); #endif if (lib$ast_in_prog ()) /* Don't wait if suspending from kbd_buffer_store_event! */ { sys$cancel (input_fd); return; } if (ast_queued) { sys$setast (0); /* Clear a flag, and tell ast routine above to set it. */ sys$clref (input_ef); #if 0 waiting_for_ast = 1; #endif stop_input = 1; sys$cancel (input_fd); sys$setast (1); #if 1 sys$waitfr (input_ef); #endif sys$clref (input_ef); #if 0 waiting_for_ast = 0; #endif stop_input = 0; } } /* Wait for either input available or time interval expiry. */ #if 0 /* Is this really needed ? */ input_wait_timeout (timeval) int timeval; /* Time to wait, in seconds */ { int time [2]; static int zero = 0; static int large = -10000000; lib$emul (&timeval, &large, &zero, time); /* Convert to VMS format */ /* If already something, avoid doing system calls. */ if (detect_input_pending ()) { return; } /* Clear a flag, and tell ast routine above to set it. */ sys$clref (input_ef); waiting_for_ast = 1; /* Check for timing error: ast happened while we were doing that. */ if (!detect_input_pending ()) { /* No timing error: wait for flag to be set. */ sys$cantim (1, 0); if (sys$setimr (timer_ef, time, 0, 1) & 1) /* Set timer */ sys$wflor (timer_ef, timer_eflist); /* Wait for timer expiry or input */ } waiting_for_ast = 0; } #endif /* The standard `sleep' routine works some other way and it stops working if you have ever quit out of it. This one continues to work. */ sys_sleep (timeval) int timeval; { int time [2]; static int zero = 0; static int large = -10000000; lib$emul (&timeval, &large, &zero, time); /* Convert to VMS format */ sys$cantim (2, 0); if (sys$setimr (timer_ef, time, 0, 2) & 1) /* Set timer */ sys$waitfr (timer_ef); /* Wait for timer expiry only */ } init_sigio () { request_sigio (); } reset_sigio () { unrequest_sigio (); } request_sigio () { sys$setast(1); } unrequest_sigio () { sys$setast(0); } #endif /* VMS */ #ifndef VMS /* For technical reasons, these are defined in vmsmap.c */ /* Note that VMS compiler won't accept defined (CANNOT_DUMP). */ #ifndef CANNOT_DUMP #define NEED_STARTS #endif #ifndef SYSTEM_MALLOC #ifndef NEED_STARTS #define NEED_STARTS #endif #endif #ifdef NEED_STARTS /* Some systems that cannot dump also cannot implement these. */ /* * Return the address of the start of the text segment prior to * doing an unexec. After unexec the return value is undefined. * See crt0.c for further explanation and _start. * */ #if !defined (CANNOT_UNEXEC) && !defined (HAVE_TEXT_START) char * start_of_text () { #ifdef TEXT_START return ((char *) TEXT_START); #else #ifdef GOULD extern csrt (); return ((char *) csrt); #else /* not GOULD */ extern int _start (); return ((char *) _start); #endif /* GOULD */ #endif /* TEXT_START */ } #endif /* not CANNOT_UNEXEC and not HAVE_TEXT_START */ /* * Return the address of the start of the data segment prior to * doing an unexec. After unexec the return value is undefined. * See crt0.c for further information and definition of data_start. * * Apparently, on BSD systems this is etext at startup. On * USG systems (swapping) this is highly mmu dependent and * is also dependent on whether or not the program is running * with shared text. Generally there is a (possibly large) * gap between end of text and start of data with shared text. * * On Uniplus+ systems with shared text, data starts at a * fixed address. Each port (from a given oem) is generally * different, and the specific value of the start of data can * be obtained via the UniPlus+ specific "uvar" system call, * however the method outlined in crt0.c seems to be more portable. * * Probably what will have to happen when a USG unexec is available, * at least on UniPlus, is temacs will have to be made unshared so * that text and data are contiguous. Then once loadup is complete, * unexec will produce a shared executable where the data can be * at the normal shared text boundry and the startofdata variable * will be patched by unexec to the correct value. * */ char * start_of_data () { #ifdef DATA_START return ((char *) DATA_START); #else #ifdef ORDINARY_LINK /* * This is a hack. Since we're not linking crt0.c or pre_crt0.c, * data_start isn't defined. We take the address of environ, which * is known to live at or near the start of the system crt0.c, and * we don't sweat the handful of bytes that might lose. */ extern char **environ; return((char *) &environ); #else extern int data_start; return ((char *) &data_start); #endif /* ORDINARY_LINK */ #endif /* DATA_START */ } #endif /* NEED_STARTS (not CANNOT_DUMP or not SYSTEM_MALLOC) */ #ifndef CANNOT_DUMP /* Some systems that cannot dump also cannot implement these. */ /* * Return the address of the end of the text segment prior to * doing an unexec. After unexec the return value is undefined. */ char * end_of_text () { #ifdef TEXT_END return ((char *) TEXT_END); #else extern int etext; return ((char *) &etext); #endif } /* * Return the address of the end of the data segment prior to * doing an unexec. After unexec the return value is undefined. */ char * end_of_data () { #ifdef DATA_END return ((char *) DATA_END); #else extern int edata; return ((char *) &edata); #endif } #endif /* not CANNOT_DUMP */ #endif /* not VMS */ /* init_system_name sets up the string for the Lisp function system-name to return. */ #ifdef BSD4_1 #include #endif extern Lisp_Object Vsystem_name; #ifndef BSD4_1 #ifdef HAVE_SOCKETS #include #include #endif /* HAVE_SOCKETS */ #endif /* not BSD4_1 */ void init_system_name () { #ifdef BSD4_1 Vsystem_name = build_string (sysname); #else #ifndef HAVE_GETHOSTNAME struct utsname uts; uname (&uts); Vsystem_name = build_string (uts.nodename); #else /* HAVE_GETHOSTNAME */ int hostname_size = 256; char *hostname = (char *) alloca (hostname_size); /* Try to get the host name; if the buffer is too short, try again. Apparently, the only indication gethostname gives of whether the buffer was large enough is the presence or absence of a '\0' in the string. Eech. */ for (;;) { gethostname (hostname, hostname_size - 1); hostname[hostname_size - 1] = '\0'; /* Was the buffer large enough for the '\0'? */ if (strlen (hostname) < hostname_size - 1) break; hostname_size <<= 1; hostname = (char *) alloca (hostname_size); } #ifdef HAVE_SOCKETS /* Turn the hostname into the official, fully-qualified hostname. Don't do this if we're going to dump; this can confuse system libraries on some machines and make the dumped emacs core dump. */ #ifndef CANNOT_DUMP if (initialized) #endif /* not CANNOT_DUMP */ { struct hostent *hp; int count; for (count = 0; count < 10; count++) { #ifdef TRY_AGAIN h_errno = 0; #endif hp = gethostbyname (hostname); #ifdef TRY_AGAIN if (! (hp == 0 && h_errno == TRY_AGAIN)) #endif break; Fsleep_for (make_number (1), Qnil); } if (hp) { char *fqdn = hp->h_name; char *p; if (!index (fqdn, '.')) { /* We still don't have a fully qualified domain name. Try to find one in the list of alternate names */ char **alias = hp->h_aliases; while (*alias && !index (*alias, '.')) alias++; if (*alias) fqdn = *alias; } hostname = fqdn; #if 0 /* Convert the host name to lower case. */ /* Using ctype.h here would introduce a possible locale dependence that is probably wrong for hostnames. */ p = hostname; while (*p) { if (*p >= 'A' && *p <= 'Z') *p += 'a' - 'A'; p++; } #endif } } #endif /* HAVE_SOCKETS */ #ifdef VMS if (*hostname == '\0') { #endif /* VMS */ #endif /* HAVE_GETHOSTNAME */ #ifdef VMS char *sp, *end; if ((sp = egetenv ("SYS$NODE")) == 0) strcpy (hostname, "vax-vms"); else if ((end = index (sp, ':')) == 0) strcpy (hostname, sp); else { strncpy (hostname, sp, end - sp); hostname[end - sp] = '\0'; } #ifdef HAVE_GETHOSTNAME } #endif /* HAVE_GETHOSTNAME */ #endif /* VMS */ #ifdef HAVE_GETHOSTNAME Vsystem_name = build_string (hostname); #endif /* HAVE_GETHOSTNAME */ #endif /* BSD4_1 */ { unsigned char *p; for (p = XSTRING (Vsystem_name)->data; *p; p++) if (*p == ' ' || *p == '\t') *p = '-'; } } #ifndef VMS #ifndef HAVE_SELECT #ifdef HAVE_X_WINDOWS /* Cause explanatory error message at compile time, since the select emulation is not good enough for X. */ int *x = &x_windows_lose_if_no_select_system_call; #endif /* Emulate as much as select as is possible under 4.1 and needed by Gnu Emacs * Only checks read descriptors. */ /* How long to wait between checking fds in select */ #define SELECT_PAUSE 1 int select_alarmed; /* For longjmp'ing back to read_input_waiting. */ jmp_buf read_alarm_throw; /* Nonzero if the alarm signal should throw back to read_input_waiting. The read_socket_hook function sets this to 1 while it is waiting. */ int read_alarm_should_throw; SIGTYPE select_alarm () { select_alarmed = 1; #ifdef BSD4_1 sigrelse (SIGALRM); #else /* not BSD4_1 */ signal (SIGALRM, SIG_IGN); #endif /* not BSD4_1 */ if (read_alarm_should_throw) longjmp (read_alarm_throw, 1); } /* Only rfds are checked. */ int select (nfds, rfds, wfds, efds, timeout) int nfds; int *rfds, *wfds, *efds, *timeout; { int ravail = 0, orfds = 0, old_alarm; int timeoutval = timeout ? *timeout : 100000; int *local_timeout = &timeoutval; extern int proc_buffered_char[]; #ifndef subprocesses int process_tick = 0, update_tick = 0; #else extern int process_tick, update_tick; #endif SIGTYPE (*old_trap) (); unsigned char buf; if (rfds) { orfds = *rfds; *rfds = 0; } if (wfds) *wfds = 0; if (efds) *efds = 0; /* If we are looking only for the terminal, with no timeout, just read it and wait -- that's more efficient. */ if (orfds == 1 && *local_timeout == 100000 && process_tick == update_tick) { if (! detect_input_pending ()) read_input_waiting (); *rfds = 1; return 1; } /* Once a second, till the timer expires, check all the flagged read * descriptors to see if any input is available. If there is some then * set the corresponding bit in the return copy of rfds. */ while (1) { register int to_check, bit, fd; if (rfds) { for (to_check = nfds, bit = 1, fd = 0; --to_check >= 0; bit <<= 1, fd++) { if (orfds & bit) { int avail = 0, status = 0; if (bit == 1) avail = detect_input_pending (); /* Special keyboard handler */ else { #ifdef FIONREAD status = ioctl (fd, FIONREAD, &avail); #else /* no FIONREAD */ #ifdef MSDOS abort (); /* I don't think we need it. */ #else /* not MSDOS */ /* Hoping it will return -1 if nothing available or 0 if all 0 chars requested are read. */ if (proc_buffered_char[fd] >= 0) avail = 1; else { avail = read (fd, &buf, 1); if (avail > 0) proc_buffered_char[fd] = buf; } #endif /* not MSDOS */ #endif /* no FIONREAD */ } if (status >= 0 && avail > 0) { (*rfds) |= bit; ravail++; } } } } if (*local_timeout == 0 || ravail != 0 || process_tick != update_tick) break; old_alarm = alarm (0); old_trap = signal (SIGALRM, select_alarm); select_alarmed = 0; alarm (SELECT_PAUSE); /* Wait for a SIGALRM (or maybe a SIGTINT) */ while (select_alarmed == 0 && *local_timeout != 0 && process_tick == update_tick) { #ifdef MSDOS sleep_or_kbd_hit (SELECT_PAUSE, (orfds & 1) != 0); select_alarm (); #else /* not MSDOS */ /* If we are interested in terminal input, wait by reading the terminal. That makes instant wakeup for terminal input at least. */ if (orfds & 1) { read_input_waiting (); if (detect_input_pending ()) select_alarmed = 1; } else pause (); #endif /* not MSDOS */ } (*local_timeout) -= SELECT_PAUSE; /* Reset the old alarm if there was one */ alarm (0); signal (SIGALRM, old_trap); if (old_alarm != 0) { /* Reset or forge an interrupt for the original handler. */ old_alarm -= SELECT_PAUSE; if (old_alarm <= 0) kill (getpid (), SIGALRM); /* Fake an alarm with the orig' handler */ else alarm (old_alarm); } if (*local_timeout == 0) /* Stop on timer being cleared */ break; } return ravail; } /* Read keyboard input into the standard buffer, waiting for at least one character. */ /* Make all keyboard buffers much bigger when using X windows. */ #ifdef HAVE_X_WINDOWS #define BUFFER_SIZE_FACTOR 16 #else #define BUFFER_SIZE_FACTOR 1 #endif read_input_waiting () { struct input_event e; int nread, i; extern int quit_char; if (read_socket_hook) { struct input_event buf[256]; read_alarm_should_throw = 0; if (! setjmp (read_alarm_throw)) nread = (*read_socket_hook) (0, buf, 256, 1, 0); else nread = -1; /* Scan the chars for C-g and store them in kbd_buffer. */ for (i = 0; i < nread; i++) { kbd_buffer_store_event (&buf[i]); /* Don't look at input that follows a C-g too closely. This reduces lossage due to autorepeat on C-g. */ if (buf[i].kind == ascii_keystroke && XINT(buf[i].code) == quit_char) break; } } else { char buf[3]; nread = read (fileno (stdin), buf, 1); /* Scan the chars for C-g and store them in kbd_buffer. */ e.kind = ascii_keystroke; e.frame_or_window = selected_frame; e.modifiers = 0; for (i = 0; i < nread; i++) { /* Convert chars > 0177 to meta events if desired. We do this under the same conditions that read_avail_input does. */ if (read_socket_hook == 0) { /* If the user says she has a meta key, then believe her. */ if (meta_key == 1 && (buf[i] & 0x80)) e.modifiers = meta_modifier; if (meta_key != 2) buf[i] &= ~0x80; } XSET (e.code, Lisp_Int, buf[i]); kbd_buffer_store_event (&e); /* Don't look at input that follows a C-g too closely. This reduces lossage due to autorepeat on C-g. */ if (buf[i] == quit_char) break; } } } #endif /* not HAVE_SELECT */ #endif /* not VMS */ #ifdef BSD4_1 /* * Partially emulate 4.2 open call. * open is defined as this in 4.1. * * - added by Michael Bloom @ Citicorp/TTI * */ int sys_open (path, oflag, mode) char *path; int oflag, mode; { if (oflag & O_CREAT) return creat (path, mode); else return open (path, oflag); } init_sigio () { if (noninteractive) return; lmode = LINTRUP | lmode; ioctl (0, TIOCLSET, &lmode); } reset_sigio () { if (noninteractive) return; lmode = ~LINTRUP & lmode; ioctl (0, TIOCLSET, &lmode); } request_sigio () { sigrelse (SIGTINT); interrupts_deferred = 0; } unrequest_sigio () { sighold (SIGTINT); interrupts_deferred = 1; } /* still inside #ifdef BSD4_1 */ #ifdef subprocesses int sigheld; /* Mask of held signals */ sigholdx (signum) int signum; { sigheld |= sigbit (signum); sighold (signum); } sigisheld (signum) int signum; { sigheld |= sigbit (signum); } sigunhold (signum) int signum; { sigheld &= ~sigbit (signum); sigrelse (signum); } sigfree () /* Free all held signals */ { int i; for (i = 0; i < NSIG; i++) if (sigheld & sigbit (i)) sigrelse (i); sigheld = 0; } sigbit (i) { return 1 << (i - 1); } #endif /* subprocesses */ #endif /* BSD4_1 */ /* POSIX signals support - DJB */ /* Anyone with POSIX signals should have ANSI C declarations */ #ifdef POSIX_SIGNALS sigset_t old_mask, empty_mask, full_mask, temp_mask; static struct sigaction new_action, old_action; init_signals () { sigemptyset (&empty_mask); sigfillset (&full_mask); } signal_handler_t sys_signal (int signal_number, signal_handler_t action) { #ifdef DGUX /* This gets us restartable system calls for efficiency. The "else" code will works as well. */ return (berk_signal (signal_number, action)); #else sigemptyset (&new_action.sa_mask); new_action.sa_handler = action; #ifdef SA_RESTART /* Emacs mostly works better with restartable system services. If this * flag exists, we probably want to turn it on here. */ new_action.sa_flags = SA_RESTART; #else new_action.sa_flags = 0; #endif sigaction (signal_number, &new_action, &old_action); return (old_action.sa_handler); #endif /* DGUX */ } #ifndef __GNUC__ /* If we're compiling with GCC, we don't need this function, since it can be written as a macro. */ sigset_t sys_sigmask (int sig) { sigset_t mask; sigemptyset (&mask); sigaddset (&mask, sig); return mask; } #endif int sys_sigpause (sigset_t new_mask) { /* pause emulating berk sigpause... */ sigsuspend (&new_mask); return (EINTR); } /* I'd like to have these guys return pointers to the mask storage in here, but there'd be trouble if the code was saving multiple masks. I'll be safe and pass the structure. It normally won't be more than 2 bytes anyhow. - DJB */ sigset_t sys_sigblock (sigset_t new_mask) { sigset_t old_mask; sigprocmask (SIG_BLOCK, &new_mask, &old_mask); return (old_mask); } sigset_t sys_sigunblock (sigset_t new_mask) { sigset_t old_mask; sigprocmask (SIG_UNBLOCK, &new_mask, &old_mask); return (old_mask); } sigset_t sys_sigsetmask (sigset_t new_mask) { sigset_t old_mask; sigprocmask (SIG_SETMASK, &new_mask, &old_mask); return (old_mask); } #endif /* POSIX_SIGNALS */ #ifndef BSTRING #ifndef bzero void bzero (b, length) register char *b; register int length; { #ifdef VMS short zero = 0; long max_str = 65535; while (length > max_str) { (void) lib$movc5 (&zero, &zero, &zero, &max_str, b); length -= max_str; b += max_str; } if (length > 0) { max_str = length; (void) lib$movc5 (&zero, &zero, &zero, &max_str, b); } #else while (length-- > 0) *b++ = 0; #endif /* not VMS */ } #endif /* no bzero */ #ifndef bcopy /* Saying `void' requires a declaration, above, where bcopy is used and that declaration causes pain for systems where bcopy is a macro. */ bcopy (b1, b2, length) register char *b1; register char *b2; register int length; { #ifdef VMS #if 0 /* Was: __ALPHA */ memcpy (b2, b1, length); #else long max_str = 65535; while (length > max_str) { (void) lib$movc3 (&max_str, b1, b2); length -= max_str; b1 += max_str; b2 += max_str; } if (length > 0) { max_str = length; (void) lib$movc3 (&max_str, b1, b2); } #endif #else while (length-- > 0) *b2++ = *b1++; #endif /* not VMS */ } #endif /* no bcopy */ #ifndef bcmp int bcmp (b1, b2, length) /* This could be a macro! */ register char *b1; register char *b2; register int length; { #ifdef VMS struct dsc$descriptor_s src1 = {length, DSC$K_DTYPE_T, DSC$K_CLASS_S, b1}; struct dsc$descriptor_s src2 = {length, DSC$K_DTYPE_T, DSC$K_CLASS_S, b2}; return STR$COMPARE (&src1, &src2); #else while (length-- > 0) if (*b1++ != *b2++) return 1; return 0; #endif /* not VMS */ } #endif /* no bcmp */ #endif /* not BSTRING */ #ifndef HAVE_RANDOM #ifndef random /* * The BSD random returns numbers in the range of * 0 to 2e31 - 1. The USG rand returns numbers in the * range of 0 to 2e15 - 1. This is probably not significant * in this usage. */ long random () { #ifdef HAVE_LRAND48 return lrand48 (); #else /* The BSD rand returns numbers in the range of 0 to 2e31 - 1, with unusable least significant bits. The USG rand returns numbers in the range of 0 to 2e15 - 1, all usable. Let us build a usable 30 bit number from either. */ #ifdef USG return (rand () << 15) + rand (); #else return (rand () & 0x3fff8000) + (rand () >> 16); #endif #endif } srandom (arg) int arg; { #ifdef HAVE_LRAND48 srand48 (arg); #else srand (arg); #endif } #endif /* no random */ #endif /* not HAVE_RANDOM */ #ifdef WRONG_NAME_INSQUE insque (q,p) caddr_t q,p; { _insque (q,p); } #endif #ifdef VMS #ifdef getenv /* If any place else asks for the TERM variable, allow it to be overridden with the EMACS_TERM variable before attempting to translate the logical name TERM. As a last resort, ask for VAX C's special idea of the TERM variable. */ #undef getenv char * sys_getenv (name) char *name; { register char *val; static char buf[256]; static struct dsc$descriptor_s equiv = {sizeof (buf), DSC$K_DTYPE_T, DSC$K_CLASS_S, buf}; static struct dsc$descriptor_s d_name = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}; short eqlen; if (!strcmp (name, "TERM")) { val = (char *) getenv ("EMACS_TERM"); if (val) return val; val = (char *) getenv ("TERM"); if (val) return val; } if (!strcmp (name, "HOME")) { val = (char *) getenv ("HOME"); if (val) return val; } if (!strcmp (name, "PATH")) { val = (char *) getenv ("PATH"); if (val) return val; } if (!strcmp (name, "USER")) { val = (char *) getenv ("USER"); if (val) return val; } d_name.dsc$w_length = strlen (name); d_name.dsc$a_pointer = name; if (lib$sys_trnlog (&d_name, &eqlen, &equiv) == 1) { char *str = (char *) xmalloc (eqlen + 1); bcopy (buf, str, eqlen); str[eqlen] = '\0'; /* This is a storage leak, but a pain to fix. With luck, no one will ever notice. */ return str; } return (char *) getenv (name); } #endif /* getenv */ #ifdef abort /* Since VMS doesn't believe in core dumps, the only way to debug this beast is to force a call on the debugger from within the image. */ #undef abort sys_abort () { reset_sys_modes (); lib$signal (SS$_DEBUG); } #endif /* abort */ #endif /* VMS */ #ifndef HAVE_STRERROR char *strerror (int errcode) { if (errcode < sys_nerr) return sys_errlist (errcode); return 0; } #endif #ifdef VMS #define err_str(a) ((a != EVMSERR) ? strerror(a) : strerror(a,vaxc$errno)) #else #define err_str(a) (strerror(a)) #endif #ifdef VMS #ifdef LINK_CRTL_SHARE #ifdef SHAREABLE_LIB_BUG #ifndef HAVE_STRERROR /* Variables declared noshare and initialized in sharable libraries cannot be shared. The VMS linker incorrectly forces you to use a private version which is uninitialized... If not for this "feature", we could use the C library definition of sys_nerr and sys_errlist. */ int sys_nerr = 35; char *sys_errlist[] = { "error 0", "not owner", "no such file or directory", "no such process", "interrupted system call", "i/o error", "no such device or address", "argument list too long", "exec format error", "bad file number", "no child process", "no more processes", "not enough memory", "permission denied", "bad address", "block device required", "mount devices busy", "file exists", "cross-device link", "no such device", "not a directory", "is a directory", "invalid argument", "file table overflow", "too many open files", "not a typewriter", "text file busy", "file too big", "no space left on device", "illegal seek", "read-only file system", "too many links", "broken pipe", "math argument", "result too large", "I/O stream empty", "vax/vms specific error code nontranslatable error" }; #endif /* ! HAVE_STRERROR */ #endif /* SHAREABLE_LIB_BUG */ #endif /* LINK_CRTL_SHARE */ #endif /* VMS */ #ifndef HAVE_STRERROR char * strerror (errnum) int errnum; { extern char *sys_errlist[]; extern int sys_nerr; if (errnum >= 0 && errnum < sys_nerr) return sys_errlist[errnum]; return (char *) "Unknown error"; } #endif /* ! HAVE_STRERROR */ #ifdef INTERRUPTIBLE_OPEN int /* VARARGS 2 */ sys_open (path, oflag, mode) char *path; int oflag, mode; { register int rtnval; while ((rtnval = open (path, oflag, mode)) == -1 && (errno == EINTR)); return (rtnval); } #endif /* INTERRUPTIBLE_OPEN */ #ifdef INTERRUPTIBLE_CLOSE sys_close (fd) int fd; { register int rtnval; while ((rtnval = close (fd)) == -1 && (errno == EINTR)); return rtnval; } #endif /* INTERRUPTIBLE_CLOSE */ #ifdef INTERRUPTIBLE_IO int sys_read (fildes, buf, nbyte) int fildes; char *buf; unsigned int nbyte; { register int rtnval; while ((rtnval = read (fildes, buf, nbyte)) == -1 && (errno == EINTR)); return (rtnval); } int sys_write (fildes, buf, nbyte) int fildes; char *buf; unsigned int nbyte; { register int rtnval, bytes_written; bytes_written = 0; while (nbyte > 0) { rtnval = write (fildes, buf, nbyte); if (rtnval == -1) { if (errno == EINTR) continue; else return (bytes_written ? bytes_written : -1); } buf += rtnval; nbyte -= rtnval; bytes_written += rtnval; } return (bytes_written); } #endif /* INTERRUPTIBLE_IO */ #ifndef HAVE_VFORK /* * Substitute fork for vfork on USG flavors. */ vfork () { return (fork ()); } #endif /* not HAVE_VFORK */ #ifdef USG /* * All of the following are for USG. * * On USG systems the system calls are INTERRUPTIBLE by signals * that the user program has elected to catch. Thus the system call * must be retried in these cases. To handle this without massive * changes in the source code, we remap the standard system call names * to names for our own functions in sysdep.c that do the system call * with retries. Actually, for portability reasons, it is good * programming practice, as this example shows, to limit all actual * system calls to a single occurrence in the source. Sure, this * adds an extra level of function call overhead but it is almost * always negligible. Fred Fish, Unisoft Systems Inc. */ #ifndef HAVE_SYS_SIGLIST char *sys_siglist[NSIG + 1] = { #ifdef AIX /* AIX has changed the signals a bit */ "bogus signal", /* 0 */ "hangup", /* 1 SIGHUP */ "interrupt", /* 2 SIGINT */ "quit", /* 3 SIGQUIT */ "illegal instruction", /* 4 SIGILL */ "trace trap", /* 5 SIGTRAP */ "IOT instruction", /* 6 SIGIOT */ "crash likely", /* 7 SIGDANGER */ "floating point exception", /* 8 SIGFPE */ "kill", /* 9 SIGKILL */ "bus error", /* 10 SIGBUS */ "segmentation violation", /* 11 SIGSEGV */ "bad argument to system call", /* 12 SIGSYS */ "write on a pipe with no one to read it", /* 13 SIGPIPE */ "alarm clock", /* 14 SIGALRM */ "software termination signum", /* 15 SIGTERM */ "user defined signal 1", /* 16 SIGUSR1 */ "user defined signal 2", /* 17 SIGUSR2 */ "death of a child", /* 18 SIGCLD */ "power-fail restart", /* 19 SIGPWR */ "bogus signal", /* 20 */ "bogus signal", /* 21 */ "bogus signal", /* 22 */ "bogus signal", /* 23 */ "bogus signal", /* 24 */ "LAN I/O interrupt", /* 25 SIGAIO */ "PTY I/O interrupt", /* 26 SIGPTY */ "I/O intervention required", /* 27 SIGIOINT */ "HFT grant", /* 28 SIGGRANT */ "HFT retract", /* 29 SIGRETRACT */ "HFT sound done", /* 30 SIGSOUND */ "HFT input ready", /* 31 SIGMSG */ #else /* not AIX */ "bogus signal", /* 0 */ "hangup", /* 1 SIGHUP */ "interrupt", /* 2 SIGINT */ "quit", /* 3 SIGQUIT */ "illegal instruction", /* 4 SIGILL */ "trace trap", /* 5 SIGTRAP */ "IOT instruction", /* 6 SIGIOT */ "EMT instruction", /* 7 SIGEMT */ "floating point exception", /* 8 SIGFPE */ "kill", /* 9 SIGKILL */ "bus error", /* 10 SIGBUS */ "segmentation violation", /* 11 SIGSEGV */ "bad argument to system call", /* 12 SIGSYS */ "write on a pipe with no one to read it", /* 13 SIGPIPE */ "alarm clock", /* 14 SIGALRM */ "software termination signum", /* 15 SIGTERM */ "user defined signal 1", /* 16 SIGUSR1 */ "user defined signal 2", /* 17 SIGUSR2 */ "death of a child", /* 18 SIGCLD */ "power-fail restart", /* 19 SIGPWR */ #ifdef sun "window size change", /* 20 SIGWINCH */ "urgent socket condition", /* 21 SIGURG */ "pollable event occured", /* 22 SIGPOLL */ "stop (cannot be caught or ignored)", /* 23 SIGSTOP */ "user stop requested from tty", /* 24 SIGTSTP */ "stopped process has been continued", /* 25 SIGCONT */ "background tty read attempted", /* 26 SIGTTIN */ "background tty write attempted", /* 27 SIGTTOU */ "virtual timer expired", /* 28 SIGVTALRM */ "profiling timer expired", /* 29 SIGPROF */ "exceeded cpu limit", /* 30 SIGXCPU */ "exceeded file size limit", /* 31 SIGXFSZ */ "process's lwps are blocked", /* 32 SIGWAITING */ "special signal used by thread library", /* 33 SIGLWP */ #ifdef SIGFREEZE "Special Signal Used By CPR", /* 34 SIGFREEZE */ #endif #ifdef SIGTHAW "Special Signal Used By CPR", /* 35 SIGTHAW */ #endif #endif /* sun */ #endif /* not AIX */ 0 }; #endif /* HAVE_SYS_SIGLIST */ /* * Warning, this function may not duplicate 4.2 action properly * under error conditions. */ #ifndef MAXPATHLEN /* In 4.1, param.h fails to define this. */ #define MAXPATHLEN 1024 #endif #ifndef HAVE_GETWD char * getwd (pathname) char *pathname; { char *npath, *spath; extern char *getcwd (); BLOCK_INPUT; /* getcwd uses malloc */ spath = npath = getcwd ((char *) 0, MAXPATHLEN); if (spath == 0) return spath; /* On Altos 3068, getcwd can return @hostname/dir, so discard up to first slash. Should be harmless on other systems. */ while (*npath && *npath != '/') npath++; strcpy (pathname, npath); xfree (spath); /* getcwd uses malloc */ UNBLOCK_INPUT; return pathname; } #endif /* HAVE_GETWD */ /* * Emulate rename using unlink/link. Note that this is * only partially correct. Also, doesn't enforce restriction * that files be of same type (regular->regular, dir->dir, etc). */ /* The VMS version is defined later */ #if defined(HAVE_RENAME) && !defined(VMS) rename (from, to) const char *from; const char *to; { if (access (from, 0) == 0) { unlink (to); if (link (from, to) == 0) if (unlink (from) == 0) return (0); } return (-1); } #endif #ifdef MISSING_UTIMES /* HPUX (among others) sets HAVE_TIMEVAL but does not implement utimes. */ utimes () { } #endif #ifdef IRIS_UTIME /* The IRIS (3.5) has timevals, but uses sys V utime, and doesn't have the utimbuf structure defined anywhere but in the man page. */ struct utimbuf { long actime; long modtime; }; utimes (name, tvp) char *name; struct timeval tvp[]; { struct utimbuf utb; utb.actime = tvp[0].tv_sec; utb.modtime = tvp[1].tv_sec; utime (name, &utb); } #endif /* IRIS_UTIME */ #ifdef HPUX #ifndef HAVE_PERROR /* HPUX curses library references perror, but as far as we know it won't be called. Anyway this definition will do for now. */ perror () { } #endif /* not HAVE_PERROR */ #endif /* HPUX */ #ifndef HAVE_DUP2 /* * Emulate BSD dup2. First close newd if it already exists. * Then, attempt to dup oldd. If not successful, call dup2 recursively * until we are, then close the unsuccessful ones. */ dup2 (oldd, newd) int oldd; int newd; { register int fd, ret; sys_close (newd); #ifdef F_DUPFD fd = fcntl (oldd, F_DUPFD, newd); if (fd != newd) error ("can't dup2 (%i,%i) : %s", oldd, newd, err_str (errno)); #else fd = dup (old); if (fd == -1) return -1; if (fd == new) return new; ret = dup2 (old,new); sys_close (fd); return ret; #endif } #endif /* not HAVE_DUP2 */ /* * Gettimeofday. Simulate as much as possible. Only accurate * to nearest second. Emacs doesn't use tzp so ignore it for now. * Only needed when subprocesses are defined. */ #ifdef subprocesses #ifndef VMS #ifndef HAVE_GETTIMEOFDAY #ifdef HAVE_TIMEVAL /* ARGSUSED */ gettimeofday (tp, tzp) struct timeval *tp; struct timezone *tzp; { extern long time (); tp->tv_sec = time ((long *)0); tp->tv_usec = 0; if (tzp != 0) tzp->tz_minuteswest = -1; } #endif #endif #endif #endif /* subprocess && !HAVE_GETTIMEOFDAY && HAVE_TIMEVAL && !VMS */ /* * This function will go away as soon as all the stubs fixed. (fnf) */ croak (badfunc) char *badfunc; { printf ("%s not yet implemented\r\n", badfunc); reset_sys_modes (); exit (1); } #endif /* USG */ #ifdef DGUX char *sys_siglist[NSIG + 1] = { "null signal", /* 0 SIGNULL */ "hangup", /* 1 SIGHUP */ "interrupt", /* 2 SIGINT */ "quit", /* 3 SIGQUIT */ "illegal instruction", /* 4 SIGILL */ "trace trap", /* 5 SIGTRAP */ "abort termination", /* 6 SIGABRT */ "SIGEMT", /* 7 SIGEMT */ "floating point exception", /* 8 SIGFPE */ "kill", /* 9 SIGKILL */ "bus error", /* 10 SIGBUS */ "segmentation violation", /* 11 SIGSEGV */ "bad argument to system call", /* 12 SIGSYS */ "write on a pipe with no reader", /* 13 SIGPIPE */ "alarm clock", /* 14 SIGALRM */ "software termination signal", /* 15 SIGTERM */ "user defined signal 1", /* 16 SIGUSR1 */ "user defined signal 2", /* 17 SIGUSR2 */ "child stopped or terminated", /* 18 SIGCLD */ "power-fail restart", /* 19 SIGPWR */ "window size changed", /* 20 SIGWINCH */ "undefined", /* 21 */ "pollable event occurred", /* 22 SIGPOLL */ "sendable stop signal not from tty", /* 23 SIGSTOP */ "stop signal from tty", /* 24 SIGSTP */ "continue a stopped process", /* 25 SIGCONT */ "attempted background tty read", /* 26 SIGTTIN */ "attempted background tty write", /* 27 SIGTTOU */ "undefined", /* 28 */ "undefined", /* 29 */ "undefined", /* 30 */ "undefined", /* 31 */ "undefined", /* 32 */ "socket (TCP/IP) urgent data arrival", /* 33 SIGURG */ "I/O is possible", /* 34 SIGIO */ "exceeded cpu time limit", /* 35 SIGXCPU */ "exceeded file size limit", /* 36 SIGXFSZ */ "virtual time alarm", /* 37 SIGVTALRM */ "profiling time alarm", /* 38 SIGPROF */ "undefined", /* 39 */ "file record locks revoked", /* 40 SIGLOST */ "undefined", /* 41 */ "undefined", /* 42 */ "undefined", /* 43 */ "undefined", /* 44 */ "undefined", /* 45 */ "undefined", /* 46 */ "undefined", /* 47 */ "undefined", /* 48 */ "undefined", /* 49 */ "undefined", /* 50 */ "undefined", /* 51 */ "undefined", /* 52 */ "undefined", /* 53 */ "undefined", /* 54 */ "undefined", /* 55 */ "undefined", /* 56 */ "undefined", /* 57 */ "undefined", /* 58 */ "undefined", /* 59 */ "undefined", /* 60 */ "undefined", /* 61 */ "undefined", /* 62 */ "undefined", /* 63 */ "notification message in mess. queue", /* 64 SIGDGNOTIFY */ 0 }; #endif /* DGUX */ /* Directory routines for systems that don't have them. */ #ifdef SYSV_SYSTEM_DIR #include #if defined(BROKEN_CLOSEDIR) || !defined(HAVE_CLOSEDIR) int closedir (dirp) register DIR *dirp; /* stream from opendir */ { int rtnval; rtnval = sys_close (dirp->dd_fd); /* Some systems (like Solaris) allocate the buffer and the DIR all in one block. Why in the world are we freeing this ourselves anyway? */ #if ! (defined (sun) && defined (USG5_4)) xfree ((char *) dirp->dd_buf); /* directory block defined in */ #endif xfree ((char *) dirp); return rtnval; } #endif /* BROKEN_CLOSEDIR or not HAVE_CLOSEDIR */ #endif /* SYSV_SYSTEM_DIR */ #ifdef NONSYSTEM_DIR_LIBRARY #ifdef VMS typedef struct { DIR s_dir; unsigned long context; unsigned long uflags; struct dsc$descriptor_s dir_spec; struct dsc$descriptor_s file_spec; int version_flag; unsigned long status; } VMS_DIR; #endif DIR * opendir (filename, filepattern) char *filename; /* name of directory */ char *filepattern; { #ifdef VMS register VMS_DIR *dirp; /* -> malloc'ed storage */ register unsigned int length = strlen (filename); #else register DIR *dirp; /* -> malloc'ed storage */ #endif register int fd; /* file descriptor for read */ struct stat sbuf; /* result of fstat */ struct direct * vms_low_readdir (); #ifndef VMS fd = sys_open (filename, 0); if (fd < 0) return 0; BLOCK_INPUT; if (fstat (fd, &sbuf) < 0 || (sbuf.st_mode & S_IFMT) != S_IFDIR || (dirp = (DIR *) xmalloc (sizeof (DIR))) == 0) { sys_close (fd); UNBLOCK_INPUT; return 0; /* bad luck today */ } UNBLOCK_INPUT; dirp->dd_fd = fd; #else BLOCK_INPUT; if ((filename[length-1] != ']' && filename[length-1] != '>' && filename[length-1] != ':' && (stat (filename, &sbuf) < 0 || (sbuf.st_mode & S_IFMT) != S_IFDIR)) || (dirp = (VMS_DIR *) xmalloc (sizeof (VMS_DIR))) == 0) { UNBLOCK_INPUT; return 0; /* bad luck today */ } { int count; va_count(count); if (count == 2) { dirp->file_spec.dsc$a_pointer = (char *) xmalloc (strlen (filepattern) + 1); strcpy (dirp->file_spec.dsc$a_pointer, filepattern); } else { dirp->file_spec.dsc$a_pointer = (char *) xmalloc (4); strcpy (dirp->file_spec.dsc$a_pointer, "*.*"); } dirp->file_spec.dsc$w_length = strlen (dirp->file_spec.dsc$a_pointer); dirp->file_spec.dsc$b_dtype = DSC$K_DTYPE_T; dirp->file_spec.dsc$b_class = DSC$K_CLASS_S; dirp->version_flag = strchr (dirp->file_spec.dsc$a_pointer, ';') != 0; } dirp->dir_spec.dsc$a_pointer = (char *) xmalloc (strlen (filename) + 10); UNBLOCK_INPUT; file_name_as_directory (dirp->dir_spec.dsc$a_pointer, filename); dirp->dir_spec.dsc$w_length = strlen (dirp->dir_spec.dsc$a_pointer); dirp->dir_spec.dsc$b_dtype = DSC$K_DTYPE_T; dirp->dir_spec.dsc$b_class = DSC$K_CLASS_S; dirp->status = RMS$_NORMAL; dirp->context = 0; dirp->uflags = 2; dirp->s_dir.dd_fd = 0; dirp->s_dir.dd_loc = dirp->s_dir.dd_size = 0; /* refill needed */ /* In the cases where the filename ended with `]', `>' or `:', we never checked if it really was a directory, so let's do that now, by trying to read the first entry. */ if (vms_low_readdir ((DIR *) dirp) == (struct direct *) -1) { closedir (dirp); /* was: xfree (dirp); */ return 0; } dirp->s_dir.dd_loc = 0; /* Make sure the entry just read is reused at the next call to readdir. */ #endif return (DIR *) dirp; /* I had to cast, for VMS sake. */ } void closedir (dirp) register DIR *dirp; /* stream from opendir */ { #ifndef VMS sys_close (dirp->dd_fd); #else { VMS_DIR *vms_dirp = (VMS_DIR *) dirp; if (vms_dirp->context != 0) lib$find_file_end (&(vms_dirp->context)); xfree (vms_dirp->dir_spec.dsc$a_pointer); xfree (vms_dirp->file_spec.dsc$a_pointer); } #endif xfree ((char *) dirp); } #ifndef VMS #define DIRSIZ 14 struct olddir { ino_t od_ino; /* inode */ char od_name[DIRSIZ]; /* filename */ }; #endif /* not VMS */ struct direct dir_static; /* simulated directory contents */ #ifdef VMS static struct direct * vms_low_readdir (dirp) register DIR *dirp; { static char rbuf[257]; static struct dsc$descriptor_s rdsc = { sizeof (rbuf), DSC$K_DTYPE_T, DSC$K_CLASS_S, rbuf }; VMS_DIR * vms_dirp = (VMS_DIR *) dirp; if (dirp->dd_size == 0) { char *cp, *cp2; unsigned long status; status = lib$find_file (&vms_dirp->file_spec, &rdsc, &vms_dirp->context, &vms_dirp->dir_spec, 0, 0, &vms_dirp->uflags); vms_dirp->status = status; if (status == RMS$_NMF || status == RMS$_FNF) return 0; if (status != RMS$_NORMAL) return (struct direct *) -1; rbuf [256] = '\0'; if (cp = strchr (rbuf, ' ')) *cp = '\0'; if ((cp = strchr (rbuf, ';')) != 0 && !vms_dirp->version_flag) *cp = '\0'; for (cp2 = rbuf - 1; cp2 != 0;) { char *cp2tmp = 0; cp = cp2 + 1; cp2 = strchr (cp, ']'); if (cp2 != 0) cp2tmp = strchr (cp2 + 1, '>'); if (cp2tmp != 0) cp2 = cp2tmp; } strcpy (dirp->dd_buf, cp); dirp->dd_size = strlen (dirp->dd_buf); dirp->dd_loc = 0; } if (vms_dirp->status != RMS$_NORMAL) return 0; dir_static.d_ino = -1; /* Couldn't care less... */ dir_static.d_namlen = strlen (dirp->dd_buf); dir_static.d_reclen = sizeof (struct direct) - MAXNAMLEN + 3 + dir_static.d_namlen - dir_static.d_namlen % 4; strcpy (dir_static.d_name, dirp->dd_buf); dir_static.d_name[dir_static.d_namlen] = '\0'; dirp->dd_loc = dirp->dd_size; /* only one record at a time */ return &dir_static; } #endif /* ARGUSED */ struct direct * readdir (dirp) register DIR *dirp; /* stream from opendir */ { #ifndef VMS register struct olddir *dp; /* -> directory data */ #else /* VMS */ register struct direct *dp; #endif /* VMS */ for (; ;) { if (dirp->dd_loc >= dirp->dd_size) dirp->dd_loc = dirp->dd_size = 0; #ifndef VMS if (dirp->dd_size == 0 /* refill buffer */ && (dirp->dd_size = sys_read (dirp->dd_fd, dirp->dd_buf, DIRBLKSIZ)) <= 0) return 0; dp = (struct olddir *) &dirp->dd_buf[dirp->dd_loc]; dirp->dd_loc += sizeof (struct olddir); if (dp->od_ino != 0) /* not deleted entry */ { dir_static.d_ino = dp->od_ino; strncpy (dir_static.d_name, dp->od_name, DIRSIZ); dir_static.d_name[DIRSIZ] = '\0'; dir_static.d_namlen = strlen (dir_static.d_name); dir_static.d_reclen = sizeof (struct direct) - MAXNAMLEN + 3 + dir_static.d_namlen - dir_static.d_namlen % 4; return &dir_static; /* -> simulated structure */ } #else /* VMS */ dp = vms_low_readdir (dirp); if (dp == 0 || dp == (struct direct *) -1) return 0; return dp; #endif /* VMS */ } } #ifdef VMS #if 0 /* not used any more... I think... Richard Levitte */ /* readdirver is just like readdir except it returns all versions of a file as separate entries. */ /* ARGUSED */ struct direct * readdirver (dirp) register DIR *dirp; /* stream from opendir */ { return vms_low_readdir (dirp, "*.*;*"); } #endif /* 0 */ #endif /* VMS */ #endif /* NONSYSTEM_DIR_LIBRARY */ /* mkdir and rmdir functions, for systems which don't have them. */ #ifndef HAVE_MKDIR /* * Written by Robert Rother, Mariah Corporation, August 1985. * * If you want it, it's yours. All I ask in return is that if you * figure out how to do this in a Bourne Shell script you send me * a copy. * sdcsvax!rmr or rmr@uscd * * Severely hacked over by John Gilmore to make a 4.2BSD compatible * subroutine. 11Mar86; hoptoad!gnu * * Modified by rmtodd@uokmax 6-28-87 -- when making an already existing dir, * subroutine didn't return EEXIST. It does now. */ /* * Make a directory. */ #ifdef MKDIR_PROTOTYPE MKDIR_PROTOTYPE #else int mkdir (dpath, dmode) char *dpath; int dmode; #endif { int cpid, status, fd; struct stat statbuf; if (stat (dpath, &statbuf) == 0) { errno = EEXIST; /* Stat worked, so it already exists */ return -1; } /* If stat fails for a reason other than non-existence, return error */ if (errno != ENOENT) return -1; synch_process_alive = 1; switch (cpid = fork ()) { case -1: /* Error in fork */ return (-1); /* Errno is set already */ case 0: /* Child process */ /* * Cheap hack to set mode of new directory. Since this * child process is going away anyway, we zap its umask. * FIXME, this won't suffice to set SUID, SGID, etc. on this * directory. Does anybody care? */ status = umask (0); /* Get current umask */ status = umask (status | (0777 & ~dmode)); /* Set for mkdir */ fd = sys_open("/dev/null", 2); if (fd >= 0) { dup2 (fd, 0); dup2 (fd, 1); dup2 (fd, 2); } execl ("/bin/mkdir", "mkdir", dpath, (char *) 0); _exit (-1); /* Can't exec /bin/mkdir */ default: /* Parent process */ wait_for_termination (cpid); } if (synch_process_death != 0 || synch_process_retcode != 0) { errno = EIO; /* We don't know why, but */ return -1; /* /bin/mkdir failed */ } return 0; } #endif /* not HAVE_MKDIR */ #ifndef HAVE_RMDIR int rmdir (dpath) char *dpath; { /* At least, VAX C does not have rmdir, and it surely doesn't have fork (). */ #ifdef VMS /* We allocate up to 255 extra chars, because eventual logical name translations might need it. --- Richard Levitte */ char * buf = (char *) alloca (strlen (dpath) + 255); extern int directory_file_name (); /* We want the directories file name, and then we just try to delete it */ directory_file_name (dpath, buf); if (delete (buf)) return -1; #else /* ! VMS */ int cpid, status, fd; struct stat statbuf; if (stat (dpath, &statbuf) != 0) { /* Stat just set errno. We don't have to */ return -1; } synch_process_alive = 1; switch (cpid = fork ()) { case -1: /* Error in fork */ return (-1); /* Errno is set already */ case 0: /* Child process */ fd = sys_open("/dev/null", 2); if (fd >= 0) { dup2 (fd, 0); dup2 (fd, 1); dup2 (fd, 2); } wait_for_termination (cpid); if (synch_process_death != 0 || synch_process_retcode != 0) return -1; /* /bin/rmdir failed */ default: /* Parent process */ while (cpid != wait (&status)); /* Wait for kid to finish */ } if (WIFSIGNALED (status) || WEXITSTATUS (status) != 0) { errno = EIO; /* We don't know why, but */ return -1; /* /bin/mkdir failed */ } #endif /* VMS */ return 0; } #endif /* !HAVE_RMDIR */ /* Functions for VMS */ #ifdef VMS #include "vms-pwd.h" #include #include #include #include /* Return as a string the VMS error string pertaining to STATUS. Reuses the same static buffer each time it is called. */ char * vmserrstr (status) int status; /* VMS status code */ { int bufadr[2]; short len; static char buf[257]; bufadr[0] = sizeof buf - 1; bufadr[1] = (int) buf; if (! (sys$getmsg (status, &len, bufadr, 0x1, 0) & 1)) return "untranslatable VMS error status"; buf[len] = '\0'; return buf; } #ifdef access #undef access /* The following is necessary because 'access' emulation by VMS C (2.0) does * not work correctly. (It also doesn't work well in version 2.3.) */ #ifdef VMS4_4 #include #define DESCRIPTOR(name,string) struct dsc$descriptor_s name = \ { strlen (string), DSC$K_DTYPE_T, DSC$K_CLASS_S, string } typedef union { struct { unsigned short s_buflen; unsigned short s_code; char *s_bufadr; unsigned short *s_retlenadr; } s; int end; } item; #define buflen s.s_buflen #define code s.s_code #define bufadr s.s_bufadr #define retlenadr s.s_retlenadr #define ITEMSETUP(CODE,VAR,RETLEN) \ itemlst[cnt].s.s_buflen = sizeof (VAR); \ itemlst[cnt].s.s_code = CODE; \ itemlst[cnt].s.s_bufadr = (char *) &VAR; \ itemlst[cnt++].s.s_retlenadr = (unsigned short *) &RETLEN #define R_OK 4 /* test for read permission */ #define W_OK 2 /* test for write permission */ #define X_OK 1 /* test for execute (search) permission */ #define F_OK 0 /* test for presence of file */ int sys_access (path, mode) char *path; int mode; { static char *user = NULL; char dir_fn[512]; /* translate possible directory spec into .DIR file name, so brain-dead * access can treat the directory like a file. */ if (directory_file_name (path, dir_fn)) path = dir_fn; if (mode == F_OK) return access (path, mode); if (user == NULL && (user = (char *) getenv ("USER")) == NULL) return -1; { int stat; int flags; int acces; unsigned short int dummy; int cnt; int prvmask[2]; item itemlst[8]; struct FAB fab; struct XABPRO xab; char *aclbuf; flags = 0; acces = 0; if (mode & X_OK) acces |= ARM$M_EXECUTE; if (mode & R_OK) acces |= ARM$M_READ; if (mode & W_OK) acces |= ARM$M_WRITE; flags = acces; /* Find privilege bits */ stat = sys$setprv (0, 0, 0, prvmask); /* Open the file, and find the particulars. */ fab = cc$rms_fab; fab.fab$b_fac = FAB$M_GET; fab.fab$l_fna = path; fab.fab$b_fns = strlen (path); fab.fab$l_xab = (char*) &xab; xab = cc$rms_xabpro; xab.xab$l_aclbuf = (char*) alloca(60); /* Use 60 initially */; xab.xab$w_aclsiz = 60; stat = sys$open (&fab, 0, 0); sys$close (&fab, 0, 0); if (! (stat & 1)) return -1; /* If ACL was not empty (2512) or invalid buffer length, and error occurred, then deny access. */ if (xab.xab$l_aclsts != SS$_ACLEMPTY && xab.xab$l_aclsts != SS$_IVBUFLEN && ! (xab.xab$l_aclsts & 1)) return -1; /* See if we allocated enough space for the ACL. If not, create a larger buffer (now that we now know the actual size), and do it again. */ if(xab.xab$w_acllen > xab.xab$w_aclsiz){ xab.xab$l_aclbuf = (char *) alloca(xab.xab$w_acllen); xab.xab$w_aclsiz = xab.xab$w_acllen; xab.xab$l_aclctx = 0; stat = sys$open (&fab, 0, 0); sys$close (&fab, 0, 0); if (! (stat & 1)) return -1; }; cnt=0; ITEMSETUP(CHP$_OWNER,xab.xab$l_uic,dummy); ITEMSETUP(CHP$_PROT,xab.xab$w_pro,dummy); ITEMSETUP(CHP$_ACCESS,acces,dummy); ITEMSETUP(CHP$_FLAGS,flags,dummy); if (xab.xab$w_acllen != 0) { itemlst[cnt].s.s_buflen = xab.xab$w_acllen; itemlst[cnt].s.s_code = CHP$_ACL; itemlst[cnt].s.s_bufadr = xab.xab$l_aclbuf; itemlst[cnt++].s.s_retlenadr = (unsigned short *) &dummy; }; ITEMSETUP(CHP$_PRIV,prvmask,dummy); /* ITEMSETUP(CHP$_PRIVUSED,pused,pusedl); For diagnostic purposes only */ itemlst[cnt].s.s_buflen = 0; itemlst[cnt].s.s_code = CHP$_END; /* sys$check_access can get privileges wrong. sys$chkpro will not. */ stat = sys$chkpro(itemlst); return stat == SS$_NORMAL ? 0 : -1; } } #else /* not VMS4_4 */ #include #define ACE$M_WRITE 2 #define ACE$C_KEYID 1 static unsigned short memid, grpid; static unsigned int uic; /* Called from init_sys_modes, so it happens not very often but at least each time Emacs is loaded. */ sys_access_reinit () { uic = 0; } int sys_access (filename, type) char * filename; int type; { struct FAB fab; struct XABPRO xab; int status, size, i, typecode, acl_controlled; unsigned int *aclptr, *aclend, aclbuf[60]; union prvdef prvmask; /* Get UIC and GRP values for protection checking. */ if (uic == 0) { status = lib$getjpi (&JPI$_UIC, 0, 0, &uic, 0, 0); if (! (status & 1)) return -1; memid = uic & 0xFFFF; grpid = uic >> 16; } if (type != 2) /* not checking write access */ return access (filename, type); /* Check write protection. */ #define CHECKPRIV(bit) (prvmask.bit) #define WRITEABLE(field) (! ((xab.xab$w_pro >> field) & XAB$M_NOWRITE)) /* Find privilege bits */ status = sys$setprv (0, 0, 0, prvmask); if (! (status & 1)) error ("Unable to find privileges: %s", vmserrstr (status)); if (CHECKPRIV (PRV$V_BYPASS)) return 0; /* BYPASS enabled */ fab = cc$rms_fab; fab.fab$b_fac = FAB$M_GET; fab.fab$l_fna = filename; fab.fab$b_fns = strlen (filename); fab.fab$l_xab = &xab; xab = cc$rms_xabpro; xab.xab$l_aclbuf = aclbuf; xab.xab$w_aclsiz = sizeof (aclbuf); status = sys$open (&fab, 0, 0); if (! (status & 1)) return -1; sys$close (&fab, 0, 0); /* Check system access */ if (CHECKPRIV (PRV$V_SYSPRV) && WRITEABLE (XAB$V_SYS)) return 0; /* Check ACL entries, if any */ acl_controlled = 0; if (xab.xab$w_acllen > 0) { aclptr = aclbuf; aclend = &aclbuf[xab.xab$w_acllen / 4]; while (*aclptr && aclptr < aclend) { size = (*aclptr & 0xff) / 4; typecode = (*aclptr >> 8) & 0xff; if (typecode == ACE$C_KEYID) for (i = size - 1; i > 1; i--) if (aclptr[i] == uic) { acl_controlled = 1; if (aclptr[1] & ACE$M_WRITE) return 0; /* Write access through ACL */ } aclptr = &aclptr[size]; } if (acl_controlled) /* ACL specified, prohibits write access */ return -1; } /* No ACL entries specified, check normal protection */ if (WRITEABLE (XAB$V_WLD)) /* World writeable */ return 0; if (WRITEABLE (XAB$V_GRP) && (unsigned short) (xab.xab$l_uic >> 16) == grpid) return 0; /* Group writeable */ if (WRITEABLE (XAB$V_OWN) && (xab.xab$l_uic & 0xFFFF) == memid) return 0; /* Owner writeable */ return -1; /* Not writeable */ } #endif /* not VMS4_4 */ #endif /* access */ static char vtbuf[NAM$C_MAXRSS+1]; /* translate a vms file spec to a unix path */ char * sys_translate_vms (vfile) char * vfile; { char * p; char * targ; if (!vfile) return 0; targ = vtbuf; /* leading device or logical name is a root directory */ if (p = strchr (vfile, ':')) { *targ++ = '/'; while (vfile < p) *targ++ = *vfile++; vfile++; *targ++ = '/'; } p = vfile; if (*p == '[' || *p == '<') { while (*++vfile != *p + 2) switch (*vfile) { case '.': if (vfile[-1] == *p) *targ++ = '.'; *targ++ = '/'; break; case '-': *targ++ = '.'; *targ++ = '.'; break; default: *targ++ = *vfile; break; } vfile++; *targ++ = '/'; } while (*vfile) *targ++ = *vfile++; return vtbuf; } static char utbuf[NAM$C_MAXRSS+1]; /* translate a unix path to a VMS file spec */ char * sys_translate_unix (ufile) char * ufile; #ifndef TEST_VMS_ALTERNATIVE_TRANSLATE_UNIX { int slash_seen = 0; char *p; char * targ; if (!ufile) return 0; targ = utbuf; if (*ufile == '/') { ufile++; } else if (index (&ufile[1], '/') && strncmp (ufile, "./", 2) != 0) { /* If there is no leading slash, this is a relative dir spec, and thus, the first directory name should NOT be converted to a device name */ slash_seen = 1; *targ++ = '['; *targ++ = '.'; } while (*ufile) { switch (*ufile) { case '/': if (slash_seen) if (index (&ufile[1], '/')) *targ++ = '.'; else *targ++ = ']'; else { *targ++ = ':'; if (index (&ufile[1], '/')) *targ++ = '['; slash_seen = 1; } break; case '.': if (strncmp (ufile, "./", 2) == 0) { if (!slash_seen) { *targ++ = '['; slash_seen = 1; } ufile++; /* skip the dot */ if (index (&ufile[1], '/')) *targ++ = '.'; else *targ++ = ']'; } else if (strncmp (ufile, "../", 3) == 0) { if (!slash_seen) { *targ++ = '['; slash_seen = 1; } *targ++ = '-'; ufile += 2; /* skip the dots */ if (index (&ufile[1], '/')) *targ++ = '.'; else *targ++ = ']'; } else if (strcmp (ufile, "..") == 0) { if (!slash_seen) { *targ++ = '['; slash_seen = 1; } *targ++ = '-'; *targ++ = ']'; ufile ++; /* skip the dots */ } else *targ++ = *ufile; break; default: *targ++ = *ufile; break; } ufile++; } *targ = '\0'; return utbuf; } #else /* TEST_VMS_ALTERNATIVE_TRANSLATE_UNIX */ /* This needs some revision... to be done soon. --- Richard Levitte */ { char *s2 = utbuf; char *t2 = s2; char *component_start = 0, *component_end = 0; int device_done = 0, first_dir_done = 0, rooted = 0; for(t = ufile, component_start = ufile; *t != '\0'; t++) { switch(*t) { case '/': *t = '\0'; if (t != ufile) { if (strcmp(component_start, ".") == 0) ; else if (strcmp(component_start, "..") == 0) { if (!first_dir_done) { first_dir_done = 1; *t2++ = '['; } else *t2++ = '.'; *t2++ = '-'; } else if (first_dir_done) { *t2++ = '.'; strcpy(t2, component_start); t2 += strlen(t2); } else if (rooted && !device_done) { strcpy(t2, component_start); t2 += strlen(t2); *t2++ = ':'; } else { /* Now, there's just the case of the first dir */ *t2++ = '['; if (!rooted) *t2++ = '.'; strcpy(t2, component_start); t2 += strlen(t2); first_dir_done = 1; } device_done = 1; } else { rooted = 1; } component_start = t + 1; break; } } if (t2 != s && rooted && !first_dir_done) { strcpy(t2, "[000000"); t2 += 7; first_dir_done = 1; } if (first_dir_done) *t2++ = ']'; if (component_start != t) { int count_dots=0; strcpy(t2, component_start); component_start = strchr(t2, ']'); if (component_start) t2 = component_start + 1; for(; *t2 != '\0'; t2++) switch (*t2) { case '.': if (count_dots) *t2 = '_'; /* We have no use of version numbers */ count_dots = 1; break; case '+': *t2 = '_'; break; case '#': *t2 = '$'; break; } } else { xfree(s2); xfree(s); xfree(ufile); ufile = Nullch; return ufile; } xfree(s); s = s2; ufile = s; } #endif /* TEST_VMS_ALTERNATIVE_TRANSLATE_UNIX */ char * getwd (pathname) char *pathname; { char *ptr, *val; extern char *getcwd (); #define MAXPATHLEN 1024 ptr = xmalloc (MAXPATHLEN); val = getcwd (ptr, MAXPATHLEN); if (val == 0) { xfree (ptr); return val; } strcpy (pathname, ptr); xfree (ptr); return pathname; } #ifdef SYI$_PAGE_SIZE /* This in only on the AXP */ /* getpagelog () assumes page sizes are powers of 2. */ int getpagelog () { int i = getpagesize (); int j = 1; if (i > 2) return 0; for (i /= 2; i & 1 != 1; i /= 2) j++; return j; } int getpagesize () { int foo; struct { short buffer_length; short item_code; char *buffer_addr; int *return_length; } itmlst[] = { { 4, SYI$_PAGE_SIZE, (char *) &foo, 0 }, { 0, 0, 0, 0 } }; unsigned int status = sys$getsyiw (0, 0, 0, itmlst, 0, 0, 0); if (! (status & 1)) lib$stop (status); return foo; } #endif getppid () { long item_code = JPI$_OWNER; unsigned long parent_id; int status; if (((status = lib$getjpi (&item_code, 0, 0, &parent_id)) & 1) == 0) { errno = EVMSERR; vaxc$errno = status; return -1; } return parent_id; } #undef getuid unsigned sys_getuid () { return (getgid () << 16) | getuid (); } int sys_read (fildes, buf, nbyte) int fildes; char *buf; unsigned int nbyte; { return read (fildes, buf, (nbyte < MAXIOSIZE ? nbyte : MAXIOSIZE)); } /* * VAX/VMS VAX C RTL really loses. It insists that records * end with a newline (carriage return) character, and if they * don't it adds one (nice of it isn't it!) * * Thus we do this stupidity below. */ int sys_write (fildes, buf, nbytes) int fildes; char *buf; unsigned int nbytes; { register char *p; register char *e; int sum = 0; struct stat st; fstat (fildes, &st); p = buf; while (nbytes > 0) { int len, retval; /* Handle fixed-length files with carriage control. */ if (st.st_fab_rfm == FAB$C_FIX) { len = st.st_fab_mrs; retval = write (fildes, p, min (len, nbytes)); if (retval != len) return -1; if ((st.st_fab_rat & (FAB$M_FTN | FAB$M_CR)) != 0) retval++; /* This skips the implied carriage control */ } else { e = p + min (MAXIOSIZE, nbytes) - 1; while (*e != '\n' && e > p) e--; if (p == e) /* Ok.. so here we add a newline... sigh. */ e = p + min (MAXIOSIZE, nbytes) - 1; len = e + 1 - p; retval = write (fildes, p, len); if (retval != len) return -1; } p += retval; sum += retval; nbytes -= retval; } return sum; } /* Create file NEW copying its attributes from file OLD. If OLD is 0 or does not exist, create based on the value of vms_stmlf_recfm. */ /* Protection value the file should ultimately have. Set by create_copy_attrs, and use by rename_sansversions. */ static unsigned short int fab_final_pro; int creat_copy_attrs (old, new) char *old, *new; { struct FAB fab = cc$rms_fab; struct XABPRO xabpro; char aclbuf[256]; /* Choice of size is arbitrary. See below. */ extern int vms_stmlf_recfm; if (old) { fab.fab$b_fac = FAB$M_GET; fab.fab$l_fna = old; fab.fab$b_fns = strlen (old); fab.fab$l_xab = (char *) &xabpro; xabpro = cc$rms_xabpro; xabpro.xab$l_aclbuf = aclbuf; xabpro.xab$w_aclsiz = sizeof aclbuf; /* Call $OPEN to fill in the fab & xabpro fields. */ if (sys$open (&fab, 0, 0) & 1) { sys$close (&fab, 0, 0); fab.fab$l_alq = 0; /* zero the allocation quantity */ if (xabpro.xab$w_acllen > 0) { if (xabpro.xab$w_acllen > sizeof aclbuf) /* If the acl buffer was too short, redo open with longer one. Wouldn't need to do this if there were some system imposed limit on the size of an ACL, but I can't find any such. */ { xabpro.xab$l_aclbuf = (char *) alloca (xabpro.xab$w_acllen); xabpro.xab$w_aclsiz = xabpro.xab$w_acllen; if (sys$open (&fab, 0, 0) & 1) sys$close (&fab, 0, 0); else old = 0; } } else xabpro.xab$l_aclbuf = 0; } else old = 0; } fab.fab$l_fna = new; fab.fab$b_fns = strlen (new); if (!old) { fab.fab$l_xab = 0; fab.fab$b_rfm = vms_stmlf_recfm ? FAB$C_STMLF : FAB$C_VAR; fab.fab$b_rat = FAB$M_CR; } /* Set the file protections such that we will be able to manipulate this file. Once we are done writing and renaming it, we will set the protections back. */ if (old) fab_final_pro = xabpro.xab$w_pro; else sys$setdfprot (0, &fab_final_pro); xabpro.xab$w_pro &= 0xff0f; /* set O:rewd for now. This is set back later. */ /* Create the new file with either default attrs or attrs copied from old file. */ if (!(sys$create (&fab, 0, 0) & 1)) return -1; sys$close (&fab, 0, 0); /* As this is a "replacement" for creat, return a file descriptor opened for writing. */ return open (new, O_WRONLY); } #ifdef creat #undef creat #include #ifdef __GNUC__ #ifndef va_count #define va_count(X) ((X) = *(((int *) &(va_alist)) - 1)) #endif #endif sys_creat (va_alist) va_dcl { va_list list_incrementer; char *name; int mode; int rfd; /* related file descriptor */ int fd; /* Our new file descriptor */ int count; struct stat st_buf; char rfm[12]; char rat[15]; char mrs[13]; char fsz[13]; extern int vms_stmlf_recfm; va_count (count); va_start (list_incrementer); name = va_arg (list_incrementer, char *); mode = va_arg (list_incrementer, int); if (count > 2) rfd = va_arg (list_incrementer, int); va_end (list_incrementer); if (count > 2) { /* Use information from the related file descriptor to set record format of the newly created file. */ fstat (rfd, &st_buf); switch (st_buf.st_fab_rfm) { case FAB$C_FIX: strcpy (rfm, "rfm = fix"); sprintf (mrs, "mrs = %d", st_buf.st_fab_mrs); strcpy (rat, "rat = "); if (st_buf.st_fab_rat & FAB$M_CR) strcat (rat, "cr"); else if (st_buf.st_fab_rat & FAB$M_FTN) strcat (rat, "ftn"); else if (st_buf.st_fab_rat & FAB$M_PRN) strcat (rat, "prn"); if (st_buf.st_fab_rat & FAB$M_BLK) if (st_buf.st_fab_rat & (FAB$M_CR|FAB$M_FTN|FAB$M_PRN)) strcat (rat, ", blk"); else strcat (rat, "blk"); return creat (name, 0, rfm, rat, mrs); case FAB$C_VFC: strcpy (rfm, "rfm = vfc"); sprintf (fsz, "fsz = %d", st_buf.st_fab_fsz); strcpy (rat, "rat = "); if (st_buf.st_fab_rat & FAB$M_CR) strcat (rat, "cr"); else if (st_buf.st_fab_rat & FAB$M_FTN) strcat (rat, "ftn"); else if (st_buf.st_fab_rat & FAB$M_PRN) strcat (rat, "prn"); if (st_buf.st_fab_rat & FAB$M_BLK) if (st_buf.st_fab_rat & (FAB$M_CR|FAB$M_FTN|FAB$M_PRN)) strcat (rat, ", blk"); else strcat (rat, "blk"); return creat (name, 0, rfm, rat, fsz); case FAB$C_STM: strcpy (rfm, "rfm = stm"); break; case FAB$C_STMCR: strcpy (rfm, "rfm = stmcr"); break; case FAB$C_STMLF: strcpy (rfm, "rfm = stmlf"); break; case FAB$C_UDF: strcpy (rfm, "rfm = udf"); break; case FAB$C_VAR: strcpy (rfm, "rfm = var"); break; } strcpy (rat, "rat = "); if (st_buf.st_fab_rat & FAB$M_CR) strcat (rat, "cr"); else if (st_buf.st_fab_rat & FAB$M_FTN) strcat (rat, "ftn"); else if (st_buf.st_fab_rat & FAB$M_PRN) strcat (rat, "prn"); if (st_buf.st_fab_rat & FAB$M_BLK) if (st_buf.st_fab_rat & (FAB$M_CR|FAB$M_FTN|FAB$M_PRN)) strcat (rat, ", blk"); else strcat (rat, "blk"); } else { strcpy (rfm, vms_stmlf_recfm ? "rfm = stmlf" : "rfm=var"); strcpy (rat, "rat=cr"); } /* Until the VAX C RTL fixes the many bugs with modes, always use mode 0 to get the user's default protection. */ fd = creat (name, 0, rfm, rat); if (fd < 0 && errno == EEXIST) { if (unlink (name) < 0) report_file_error ("delete", build_string (name)); fd = creat (name, 0, rfm, rat); } return fd; } #endif /* creat */ /* fwrite to stdout is S L O W. Speed it up by using fputc...*/ size_t sys_fwrite (ptr, size, num, fp) register char * ptr; FILE * fp; { register int tot = num * size; while (tot--) fputc (*ptr++, fp); return num; } /* * The VMS C library routine creat actually creates a new version of an * existing file rather than truncating the old version. There are times * when this is not the desired behavior, for instance, when writing an * auto save file (you only want one version), or when you don't have * write permission in the directory containing the file (but the file * itself is writable). Hence this routine, which is equivalent to * "close (creat (fn, 0));" on Unix if fn already exists. */ int vms_truncate (fn) char *fn; { struct FAB xfab = cc$rms_fab; struct RAB xrab = cc$rms_rab; int status; xfab.fab$l_fop = FAB$M_TEF; /* free allocated but unused blocks on close */ xfab.fab$b_fac = FAB$M_TRN | FAB$M_GET; /* allow truncate and get access */ xfab.fab$b_shr = FAB$M_NIL; /* allow no sharing - file must be locked */ xfab.fab$l_fna = fn; xfab.fab$b_fns = strlen (fn); xfab.fab$l_dna = ";0"; /* default to latest version of the file */ xfab.fab$b_dns = 2; xrab.rab$l_fab = &xfab; /* This gibberish opens the file, positions to the first record, and deletes all records from there until the end of file. */ if ((sys$open (&xfab) & 01) == 01) { if ((sys$connect (&xrab) & 01) == 01 && (sys$find (&xrab) & 01) == 01 && (sys$truncate (&xrab) & 01) == 01) status = 0; else status = -1; } else status = -1; sys$close (&xfab); return status; } /* Define this symbol to actually read SYSUAF.DAT. This requires either SYSPRV or a readable SYSUAF.DAT. */ #ifdef READ_SYSUAF /* * getuaf.c * * Routine to read the VMS User Authorization File and return * a specific user's record. */ static struct UAF retuaf; struct UAF * get_uaf_name (uname) char * uname; { register status; struct FAB uaf_fab; struct RAB uaf_rab; uaf_fab = cc$rms_fab; uaf_rab = cc$rms_rab; /* initialize fab fields */ uaf_fab.fab$l_fna = "SYS$SYSTEM:SYSUAF.DAT"; uaf_fab.fab$b_fns = 21; uaf_fab.fab$b_fac = FAB$M_GET; uaf_fab.fab$b_org = FAB$C_IDX; uaf_fab.fab$b_shr = FAB$M_GET|FAB$M_PUT|FAB$M_UPD|FAB$M_DEL; /* initialize rab fields */ uaf_rab.rab$l_fab = &uaf_fab; /* open the User Authorization File */ status = sys$open (&uaf_fab); if (!(status&1)) { errno = EVMSERR; vaxc$errno = status; return 0; } status = sys$connect (&uaf_rab); if (!(status&1)) { errno = EVMSERR; vaxc$errno = status; return 0; } /* read the requested record - index is in uname */ uaf_rab.rab$l_kbf = uname; uaf_rab.rab$b_ksz = strlen (uname); uaf_rab.rab$b_rac = RAB$C_KEY; uaf_rab.rab$l_ubf = (char *)&retuaf; uaf_rab.rab$w_usz = sizeof retuaf; status = sys$get (&uaf_rab); if (!(status&1)) { errno = EVMSERR; vaxc$errno = status; return 0; } /* close the User Authorization File */ status = sys$disconnect (&uaf_rab); if (!(status&1)) { errno = EVMSERR; vaxc$errno = status; return 0; } status = sys$close (&uaf_fab); if (!(status&1)) { errno = EVMSERR; vaxc$errno = status; return 0; } return &retuaf; } struct UAF * get_uaf_uic (uic) unsigned long uic; { register status; struct FAB uaf_fab; struct RAB uaf_rab; uaf_fab = cc$rms_fab; uaf_rab = cc$rms_rab; /* initialize fab fields */ uaf_fab.fab$l_fna = "SYS$SYSTEM:SYSUAF.DAT"; uaf_fab.fab$b_fns = 21; uaf_fab.fab$b_fac = FAB$M_GET; uaf_fab.fab$b_org = FAB$C_IDX; uaf_fab.fab$b_shr = FAB$M_GET|FAB$M_PUT|FAB$M_UPD|FAB$M_DEL; /* initialize rab fields */ uaf_rab.rab$l_fab = &uaf_fab; /* open the User Authorization File */ status = sys$open (&uaf_fab); if (!(status&1)) { errno = EVMSERR; vaxc$errno = status; return 0; } status = sys$connect (&uaf_rab); if (!(status&1)) { errno = EVMSERR; vaxc$errno = status; return 0; } /* read the requested record - index is in uic */ uaf_rab.rab$b_krf = 1; /* 1st alternate key */ uaf_rab.rab$l_kbf = (char *) &uic; uaf_rab.rab$b_ksz = sizeof uic; uaf_rab.rab$b_rac = RAB$C_KEY; uaf_rab.rab$l_ubf = (char *)&retuaf; uaf_rab.rab$w_usz = sizeof retuaf; status = sys$get (&uaf_rab); if (!(status&1)) { errno = EVMSERR; vaxc$errno = status; return 0; } /* close the User Authorization File */ status = sys$disconnect (&uaf_rab); if (!(status&1)) { errno = EVMSERR; vaxc$errno = status; return 0; } status = sys$close (&uaf_fab); if (!(status&1)) { errno = EVMSERR; vaxc$errno = status; return 0; } return &retuaf; } static struct passwd retpw; struct passwd * cnv_uaf_pw (up) struct UAF * up; { char * ptr; /* copy these out first because if the username is 32 chars, the next section will overwrite the first byte of the UIC */ retpw.pw_uid = up->uaf$w_mem; retpw.pw_gid = up->uaf$w_grp; /* I suppose this is not the best sytle, to possibly overwrite one byte beyond the end of the field, but what the heck... */ ptr = &up->uaf$t_username[UAF$S_USERNAME]; while (ptr[-1] == ' ') ptr--; *ptr = '\0'; strcpy (retpw.pw_name, up->uaf$t_username); /* the rest of these are counted ascii strings */ strncpy (retpw.pw_gecos, &up->uaf$t_owner[1], up->uaf$t_owner[0]); retpw.pw_gecos[up->uaf$t_owner[0]] = '\0'; strncpy (retpw.pw_dir, &up->uaf$t_defdev[1], up->uaf$t_defdev[0]); retpw.pw_dir[up->uaf$t_defdev[0]] = '\0'; strncat (retpw.pw_dir, &up->uaf$t_defdir[1], up->uaf$t_defdir[0]); retpw.pw_dir[up->uaf$t_defdev[0] + up->uaf$t_defdir[0]] = '\0'; strncpy (retpw.pw_shell, &up->uaf$t_defcli[1], up->uaf$t_defcli[0]); retpw.pw_shell[up->uaf$t_defcli[0]] = '\0'; return &retpw; } #else /* not READ_SYSUAF */ static struct passwd retpw; #endif /* not READ_SYSUAF */ struct passwd * getpwnam (name) char * name; { #ifdef READ_SYSUAF struct UAF *up; #else char * user; char * dir; unsigned char * full; #endif /* READ_SYSUAF */ char *ptr = name; while (*ptr) { if ('a' <= *ptr && *ptr <= 'z') *ptr -= 040; ptr++; } #ifdef READ_SYSUAF if (!(up = get_uaf_name (name))) return 0; return cnv_uaf_pw (up); #else if (strcmp (name, getenv ("USER")) == 0) { retpw.pw_uid = getuid (); retpw.pw_gid = getgid (); strcpy (retpw.pw_name, name); if (full = egetenv ("FULLNAME")) strcpy (retpw.pw_gecos, full); else *retpw.pw_gecos = '\0'; strcpy (retpw.pw_dir, egetenv ("HOME")); *retpw.pw_shell = '\0'; return &retpw; } else return 0; #endif /* not READ_SYSUAF */ } struct passwd * getpwuid (uid) unsigned long uid; { #ifdef READ_SYSUAF struct UAF * up; if (!(up = get_uaf_uic (uid))) return 0; return cnv_uaf_pw (up); #else if (uid == sys_getuid ()) return getpwnam (egetenv ("USER")); else return 0; #endif /* not READ_SYSUAF */ } /* return total address space available to the current process. This is the sum of the current p0 size, p1 size and free page table entries available. */ vlimit () { int item_code; unsigned long free_pages; unsigned long frep0va; unsigned long frep1va; register status; item_code = JPI$_FREPTECNT; if (((status = lib$getjpi (&item_code, 0, 0, &free_pages)) & 1) == 0) { errno = EVMSERR; vaxc$errno = status; return -1; } free_pages *= 512; item_code = JPI$_FREP0VA; if (((status = lib$getjpi (&item_code, 0, 0, &frep0va)) & 1) == 0) { errno = EVMSERR; vaxc$errno = status; return -1; } item_code = JPI$_FREP1VA; if (((status = lib$getjpi (&item_code, 0, 0, &frep1va)) & 1) == 0) { errno = EVMSERR; vaxc$errno = status; return -1; } return free_pages + frep0va + (0x7fffffff - frep1va); } define_logical_name (varname, string) char *varname; char *string; { struct dsc$descriptor_s strdsc = {strlen (string), DSC$K_DTYPE_T, DSC$K_CLASS_S, string}; struct dsc$descriptor_s envdsc = {strlen (varname), DSC$K_DTYPE_T, DSC$K_CLASS_S, varname}; struct dsc$descriptor_s lnmdsc = {7, DSC$K_DTYPE_T, DSC$K_CLASS_S, "LNM$JOB"}; return lib$set_logical (&envdsc, &strdsc, &lnmdsc, 0, 0); } delete_logical_name (varname) char *varname; { struct dsc$descriptor_s envdsc = {strlen (varname), DSC$K_DTYPE_T, DSC$K_CLASS_S, varname}; struct dsc$descriptor_s lnmdsc = {7, DSC$K_DTYPE_T, DSC$K_CLASS_S, "LNM$JOB"}; return lib$delete_logical (&envdsc, &lnmdsc); } ulimit () {} setpgrp () {} execvp () { error ("execvp system call not implemented"); } int rename (from, to) const char *from, *to; { int status; struct FAB from_fab = cc$rms_fab, to_fab = cc$rms_fab; struct NAM from_nam = cc$rms_nam, to_nam = cc$rms_nam; char from_esn[NAM$C_MAXRSS]; char to_esn[NAM$C_MAXRSS]; from_fab.fab$l_fna = from; from_fab.fab$b_fns = strlen (from); from_fab.fab$l_nam = &from_nam; from_fab.fab$l_fop = FAB$M_NAM; from_nam.nam$l_esa = from_esn; from_nam.nam$b_ess = sizeof from_esn; to_fab.fab$l_fna = to; to_fab.fab$b_fns = strlen (to); to_fab.fab$l_nam = &to_nam; to_fab.fab$l_fop = FAB$M_NAM; to_nam.nam$l_esa = to_esn; to_nam.nam$b_ess = sizeof to_esn; status = sys$rename (&from_fab, 0, 0, &to_fab); if (status & 1) return 0; else { if (status == RMS$_DEV) errno = EXDEV; else errno = EVMSERR; vaxc$errno = status; return -1; } } /* This function renames a file like `rename', but it strips the version number from the "to" filename, such that the "to" file is will always be a new version. It also sets the file protection once it is finished. The protection that we will use is stored in fab_final_pro, and was set when we did a creat_copy_attrs to create the file that we are renaming. We could use the chmod function, but Eunichs uses 3 bits per user category to describe the protection, and VMS uses 4 (write and delete are separate bits). To maintain portability, the VMS implementation of `chmod' wires the W and D bits together. */ static struct fibdef fib; /* We need this initialized to zero */ char vms_file_written[NAM$C_MAXRSS]; int rename_sans_version (from,to) char *from, *to; { short int chan; int stat; short int iosb[4]; int status; struct FAB to_fab = cc$rms_fab; struct NAM to_nam = cc$rms_nam; struct dsc$descriptor fib_d ={sizeof (fib),0,0,(char*) &fib}; struct dsc$descriptor fib_attr[2] = {{sizeof (fab_final_pro),ATR$C_FPRO,0,(char*) &fab_final_pro},{0,0,0,0}}; char to_esn[NAM$C_MAXRSS]; $DESCRIPTOR (disk,to_esn); to_fab.fab$l_fna = to; to_fab.fab$b_fns = strlen (to); to_fab.fab$l_nam = &to_nam; to_fab.fab$l_fop = FAB$M_NAM; to_nam.nam$l_esa = to_esn; to_nam.nam$b_ess = sizeof to_esn; status = sys$parse (&to_fab, 0, 0); /* figure out the full file name */ if (to_nam.nam$l_fnb && NAM$M_EXP_VER) *(to_nam.nam$l_ver) = '\0'; stat = rename (from, to_esn); if (stat < 0) return stat; strcpy (vms_file_written, to_esn); to_fab.fab$l_fna = vms_file_written; /* this points to the versionless name */ to_fab.fab$b_fns = strlen (vms_file_written); /* Now set the file protection to the correct value */ sys$open (&to_fab, 0, 0); /* This fills in the nam$w_fid fields */ /* Copy these fields into the fib */ #ifdef __DECC fib.fib$w_fid[0] = to_nam.nam$w_fid[0]; fib.fib$w_fid[1] = to_nam.nam$w_fid[1]; fib.fib$w_fid[2] = to_nam.nam$w_fid[2]; #else fib.fib$r_fid_overlay.fib$w_fid[0] = to_nam.nam$w_fid[0]; fib.fib$r_fid_overlay.fib$w_fid[1] = to_nam.nam$w_fid[1]; fib.fib$r_fid_overlay.fib$w_fid[2] = to_nam.nam$w_fid[2]; #endif sys$close (&to_fab, 0, 0); stat = sys$assign (&disk, &chan, 0, 0); /* open a channel to the disk */ if (!stat) lib$signal (stat); stat = sys$qiow (0, chan, IO$_MODIFY, iosb, 0, 0, &fib_d, 0, 0, 0, &fib_attr, 0); if (!stat) lib$signal (stat); stat = sys$dassgn (chan); if (!stat) lib$signal (stat); strcpy (vms_file_written, to_esn); /* We will write this to the terminal*/ return 0; } link (file, new) char * file, * new; { register status; struct FAB fab; struct NAM nam; unsigned short fid[3]; char esa[NAM$C_MAXRSS]; fab = cc$rms_fab; fab.fab$l_fop = FAB$M_OFP; fab.fab$l_fna = file; fab.fab$b_fns = strlen (file); fab.fab$l_nam = &nam; nam = cc$rms_nam; nam.nam$l_esa = esa; nam.nam$b_ess = NAM$C_MAXRSS; status = sys$parse (&fab); if ((status & 1) == 0) { errno = EVMSERR; vaxc$errno = status; return -1; } status = sys$search (&fab); if ((status & 1) == 0) { errno = EVMSERR; vaxc$errno = status; return -1; } fid[0] = nam.nam$w_fid[0]; fid[1] = nam.nam$w_fid[1]; fid[2] = nam.nam$w_fid[2]; fab.fab$l_fna = new; fab.fab$b_fns = strlen (new); status = sys$parse (&fab); if ((status & 1) == 0) { errno = EVMSERR; vaxc$errno = status; return -1; } nam.nam$w_fid[0] = fid[0]; nam.nam$w_fid[1] = fid[1]; nam.nam$w_fid[2] = fid[2]; nam.nam$l_esa = nam.nam$l_name; nam.nam$b_esl = nam.nam$b_name + nam.nam$b_type + nam.nam$b_ver; status = sys$enter (&fab); if ((status & 1) == 0) { errno = EVMSERR; vaxc$errno = status; return -1; } return 0; } croak (badfunc) char *badfunc; { printf ("%s not yet implemented\r\n", badfunc); reset_sys_modes (); exit (1); } char *sys_siglist[NSIG + 1] = { "bogus signal", /* 0 */ "hangup", /* 1 SIGHUP */ "interrupt", /* 2 SIGINT */ "quit", /* 3 SIGQUIT */ "illegal instruction", /* 4 SIGILL */ "trace trap", /* 5 SIGTRAP */ "IOT instruction", /* 6 SIGIOT */ "EMT instruction", /* 7 SIGEMT */ "floating point exception", /* 8 SIGFPE */ "kill", /* 9 SIGKILL */ "bus error", /* 10 SIGBUS */ "segmentation violation", /* 11 SIGSEGV */ "bad argument to system call", /* 12 SIGSYS */ "write on a pipe with no one to read it", /* 13 SIGPIPE */ "alarm clock", /* 14 SIGALRM */ "software termination signum" /* 15 SIGTERM */ #if (NSIG > 15) , "bogus signal" /* 16 */ #ifdef __GNUC__ , "bogus signal" /* 17 */ , "bogus signal" /* 18 */ , "bogus signal" /* 19 */ , "bogus signal" /* 20 */ , "bogus signal" /* 21 */ , "bogus signal" /* 22 */ , "bogus signal" /* 23 */ , "bogus signal" /* 24 */ , "bogus signal" /* 25 */ , "bogus signal" /* 26 */ , "bogus signal" /* 27 */ , "bogus signal" /* 28 */ , "bogus signal" /* 29 */ , "bogus signal" /* 30 */ , "bogus signal" /* 31 */ #endif , 0 #endif }; #endif /* VMS */ #ifdef AIX /* Called from init_sys_modes. */ hft_init () { int junk; /* If we're not on an HFT we shouldn't do any of this. We determine if we are on an HFT by trying to get an HFT error code. If this call fails, we're not on an HFT. */ #ifdef IBMR2AIX if (ioctl (0, HFQERROR, &junk) < 0) return; #else /* not IBMR2AIX */ if (ioctl (0, HFQEIO, 0) < 0) return; #endif /* not IBMR2AIX */ /* On AIX the default hft keyboard mapping uses backspace rather than delete as the rubout key's ASCII code. Here this is changed. The bug is that there's no way to determine the old mapping, so in reset_sys_modes we need to assume that the normal map had been present. Of course, this code also doesn't help if on a terminal emulator which doesn't understand HFT VTD's. */ { struct hfbuf buf; struct hfkeymap keymap; buf.hf_bufp = (char *)&keymap; buf.hf_buflen = sizeof (keymap); keymap.hf_nkeys = 2; keymap.hfkey[0].hf_kpos = 15; keymap.hfkey[0].hf_kstate = HFMAPCHAR | HFSHFNONE; #ifdef IBMR2AIX keymap.hfkey[0].hf_keyidh = '<'; #else /* not IBMR2AIX */ keymap.hfkey[0].hf_page = '<'; #endif /* not IBMR2AIX */ keymap.hfkey[0].hf_char = 127; keymap.hfkey[1].hf_kpos = 15; keymap.hfkey[1].hf_kstate = HFMAPCHAR | HFSHFSHFT; #ifdef IBMR2AIX keymap.hfkey[1].hf_keyidh = '<'; #else /* not IBMR2AIX */ keymap.hfkey[1].hf_page = '<'; #endif /* not IBMR2AIX */ keymap.hfkey[1].hf_char = 127; hftctl (0, HFSKBD, &buf); } /* The HFT system on AIX doesn't optimize for scrolling, so it's really ugly at times. */ line_ins_del_ok = char_ins_del_ok = 0; } /* Reset the rubout key to backspace. */ hft_reset () { struct hfbuf buf; struct hfkeymap keymap; int junk; #ifdef IBMR2AIX if (ioctl (0, HFQERROR, &junk) < 0) return; #else /* not IBMR2AIX */ if (ioctl (0, HFQEIO, 0) < 0) return; #endif /* not IBMR2AIX */ buf.hf_bufp = (char *)&keymap; buf.hf_buflen = sizeof (keymap); keymap.hf_nkeys = 2; keymap.hfkey[0].hf_kpos = 15; keymap.hfkey[0].hf_kstate = HFMAPCHAR | HFSHFNONE; #ifdef IBMR2AIX keymap.hfkey[0].hf_keyidh = '<'; #else /* not IBMR2AIX */ keymap.hfkey[0].hf_page = '<'; #endif /* not IBMR2AIX */ keymap.hfkey[0].hf_char = 8; keymap.hfkey[1].hf_kpos = 15; keymap.hfkey[1].hf_kstate = HFMAPCHAR | HFSHFSHFT; #ifdef IBMR2AIX keymap.hfkey[1].hf_keyidh = '<'; #else /* not IBMR2AIX */ keymap.hfkey[1].hf_page = '<'; #endif /* not IBMR2AIX */ keymap.hfkey[1].hf_char = 8; hftctl (0, HFSKBD, &buf); } #endif /* AIX */ ap.hfkey[0].hf_kstate = HFMAPCHAR | HFSHFN