home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / prim / startup.el < prev    next >
Encoding:
Text File  |  1993-03-24  |  25.1 KB  |  697 lines
  1. ;; Process Emacs shell arguments
  2. ;; Copyright (C) 1985-1993 Free Software Foundation, Inc.
  3.  
  4. ;; This file is part of GNU Emacs.
  5.  
  6. ;; GNU Emacs is free software; you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation; either version 2, or (at your option)
  9. ;; any later version.
  10.  
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;; GNU General Public License for more details.
  15.  
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  18. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. (defun command-line-process-help (arg)
  21.   (let ((standard-output (function external-debugging-output)))
  22.     (princ (emacs-version))
  23.     (princ "\n\n")
  24.     (if (fboundp 'x-create-screen)
  25.     (princ "Emacs accepts all standard X Toolkit command line options.\
  26.   In addition,\nthe ")
  27.       (princ "The "))
  28.     (princ "following options are processed in the order encountered:
  29.  
  30.   -help            Print this message and exit.
  31.   -version        Print version info and exit.
  32.   -funcall <function>    Invoke the named lisp function with no arguments.
  33.   -f <function>        Same as -funcall.
  34.   -eval <form>        Evaluate the lisp form.  Quote it carefully.
  35.   -load <file>        Load the named file of lisp code into emacs.
  36.   -l <file>        Same as -load.
  37.   -insert <file>    Insert file into the current buffer.
  38.   -i <file>        Same as -insert.
  39.   -kill            Exit emacs.")
  40.     (if (featurep 'energize)
  41.     (princ "
  42.   -energize        Connect to the Energize server at $ENERGIZE_PORT."))
  43.     (princ "
  44.   +N <file>        Start displaying <file> at line N.
  45.  
  46. These options are processed only if they appear before all other options:
  47.  
  48.   -batch        Execute noninteractively (messages go to stderr.)
  49.             This option must be first in the list.
  50.   -nw            Inhibit the use of any window-system-specific
  51.             display code: use the current tty.
  52.   -no-init-file        Do not load an init file (~/.emacs).
  53.   -q            Same as -no-init-file.
  54.   -user <user>        Load user's init file instead of your own.
  55.   -u <user>        Same as -user.
  56.  
  57. Anything else is considered a file name, and is placed into a buffer for
  58. editing.
  59.  
  60. Emacs has an online tutorial and manuals.  Type ^Ht (Control-h t) after
  61. starting emacs to run the tutorial.  Type ^Hi to enter the manual browser.
  62. ")
  63.     (kill-emacs 0)
  64.     ))
  65.  
  66. ;;; -batch, -t, and -nw are processed by main() in emacs.c and are 
  67. ;;; never seen by lisp code.
  68.  
  69. ;;; -version and -help are special-cased as well: they imply -batch,
  70. ;;; but are left on the list for lisp code to process.
  71.  
  72.  
  73. ;; This should really be in files.el, but is used very early.
  74. (defvar directory-abbrev-alist
  75.   nil
  76.   "*Alist of abbreviations for file directories.
  77. A list of elements of the form (FROM . TO), each meaning to replace
  78. FROM with TO when it appears in a directory name.
  79. This replacement is done when setting up the default directory of a
  80. newly visited file.  *Every* FROM string should start with \\\\` or ^.
  81.  
  82. Use this feature when you have directories which you normally refer to
  83. via absolute symbolic links.  Make TO the name of the link, and FROM
  84. the name it is linked to.")
  85.  
  86. (defun abbreviate-file-name (filename &optional hack-homedir)
  87.   "Return a version of FILENAME shortened using directory-abbrev-alist.
  88. See \\[describe-variable] directory-abbrev-alist RET for more information.
  89. If optional argument HACK-HOMEDIR is non-nil, then This also substitutes
  90. \"~\" for the user's home directory."
  91.   (let ((tail directory-abbrev-alist))
  92.     (while tail
  93.       (if (string-match (car (car tail)) filename)
  94.       (setq filename
  95.         (concat (cdr (car tail)) (substring filename (match-end 0)))))
  96.       (setq tail (cdr tail))))
  97.   (if (and hack-homedir
  98.        (string-match (concat "^" (regexp-quote (expand-file-name "~")))
  99.              filename))
  100.       (setq filename (concat "~" (substring filename (match-end 0)))))
  101.   filename)
  102.  
  103.  
  104. (setq top-level '(normal-top-level))
  105.  
  106. (defvar command-line-processed nil "t once command line has been processed")
  107.  
  108. (defconst inhibit-startup-message nil
  109.   "*Non-nil inhibits the initial startup messages.
  110. This is for use in your personal init file, once you are familiar
  111. with the contents of the startup message.")
  112.  
  113. (defconst inhibit-default-init nil
  114.   "*Non-nil inhibits loading the `default' library.")
  115.  
  116. (defconst command-switch-alist nil
  117.   "Alist of command-line switches.
  118. Elements look like (SWITCH-STRING . HANDLER-FUNCTION).
  119. HANDLER-FUNCTION receives switch name as sole arg;
  120. remaining command-line args are in the variable `command-line-args-left'.")
  121.  
  122. (defvar term-setup-hook nil
  123.   "Function to be called after loading terminal-specific lisp code.
  124. It is called with no arguments.  This variable exists for users to set,
  125. so as to override the definitions made by the terminal-specific file.
  126. Emacs never sets this variable itself.")
  127.  
  128. (defvar keyboard-type nil
  129.   "The brand of keyboard you are using.  This variable is used to define
  130. the proper function and keypad keys for use under X.  It is used in a
  131. fashion analogous to the environment value TERM.")
  132.  
  133. (defvar window-setup-hook nil
  134.   "Function used to initialize window system display, after command line args.
  135. Users should not set this variable; use term-setup-hook instead.")
  136.  
  137. (defconst initial-major-mode 'lisp-interaction-mode
  138.   "Major mode command symbol to use for the initial *scratch* buffer.")
  139.  
  140. (defvar init-file-user nil
  141.   "When the `.emacs' file is read, this says which user's init file it is.
  142. The value may be the null string or a string containing a user's name.
  143. If the value is a null string, it means that the init file was taken from
  144. the user that originally logged in.
  145.  
  146. In all cases, `(concat \"~\" init-file-user \"/\")' evaluates to the
  147. directory name of the directory where the `.emacs' file was looked for.")
  148.  
  149. (defvar command-line-args-left) ; bound by `command-line'
  150.  
  151. (defvar site-run-file "site-run"
  152.   "File containing site-wide run-time initializations.
  153. This file is loaded at run-time before ~/.emacs.  It contains inits
  154. that need to be in place for the entire site, but which, due to their
  155. higher incidence of change, don't make sense to load into emacs'
  156. dumped image.  Thus, the run-time load order is: 1. file described in
  157. this variable, if non-nil; 2. ~/.emacs; 3. default.el.")
  158.  
  159.  
  160. ;;; default switches
  161.  
  162. (defun command-line-process-funcall (arg)
  163.   (let ((fn (intern (car command-line-args-left))))
  164.     (setq command-line-args-left (cdr command-line-args-left))
  165.     (funcall fn)))
  166.  
  167. (defun command-line-process-eval (arg)
  168.   (let ((form (car command-line-args-left)))
  169.     (setq command-line-args-left (cdr command-line-args-left))
  170.     (eval (read form))))
  171.  
  172. (defun command-line-process-load (arg)
  173.   (let ((file (car command-line-args-left)))
  174.     ;; Take file from default dir if it exists there;
  175.     ;; otherwise let `load' search for it.
  176.     (if (file-exists-p (expand-file-name file))
  177.     (setq file (expand-file-name file)))
  178.     (load file nil t))
  179.   (setq command-line-args-left (cdr command-line-args-left)))
  180.  
  181. (defun command-line-process-insert (arg)
  182.   (insert-file-contents (car command-line-args-left))
  183.   (setq command-line-args-left (cdr command-line-args-left)))
  184.  
  185. (defun command-line-process-kill (arg)
  186.   (kill-emacs t))
  187.  
  188. (defun command-line-process-version (arg)
  189.   (princ (concat (emacs-version) "\n") (function external-debugging-output))
  190.   (kill-emacs 0))
  191.  
  192. (setq command-switch-alist
  193.       '(("-f"        . command-line-process-funcall)
  194.     ("-e"        . command-line-process-funcall)
  195.     ("-funcall"    . command-line-process-funcall)
  196.     ("-eval"    . command-line-process-eval)
  197.     ("-l"        . command-line-process-load)
  198.     ("-load"    . command-line-process-load)
  199.     ("-i"        . command-line-process-insert)
  200.     ("-insert"    . command-line-process-insert)
  201.     ("-kill"    . command-line-process-kill)
  202.     ("-version"    . command-line-process-version)
  203.     ("-help"    . command-line-process-help)
  204.     ;; Options like +35 are handled specially.
  205.     ;; Window-system, site, or package-specific code might add to this.
  206.     ;; X11 handles its options by letting Xt remove args from this list.
  207.     ))
  208.  
  209.  
  210. (defun premature-death-function (string &optional error)
  211.   (let ((stream (function external-debugging-output)))
  212.     (princ (if error 
  213.            (format "\n%s: %s%s%s\n" string
  214.                (get (car error) 'error-message)
  215.                (if (cdr error) ": ")
  216.                (mapconcat 'prin1-to-string (cdr error) ", "))
  217.          string)
  218.        stream)
  219.     (if (getenv "EMACSLOADPATH")
  220.     (princ (format "\n$EMACSLOADPATH is %s" (getenv "EMACSLOADPATH"))
  221.            stream))
  222.     (princ (format "\nload-path is %S" load-path) stream)
  223.     (princ (format "\nexec-directory is %S\n" exec-directory) stream))
  224.   (kill-emacs 33))
  225.  
  226. (defun normal-top-level ()
  227.   (if command-line-processed
  228.       (message "Back to top level.")
  229.     (setq command-line-processed t)
  230.     ;; In presence of symlinks, switch to cleaner form of default directory.
  231.     (if (not (eq system-type 'vax-vms))
  232.     (mapcar (function
  233.          (lambda (var)
  234.            (let ((value (getenv var)))
  235.              (if (and value
  236.                   (< (length value) (length default-directory))
  237.                   (equal (file-attributes default-directory)
  238.                      (file-attributes value)))
  239.              (setq default-directory
  240.                    (file-name-as-directory value))))))
  241.         '("PWD" "HOME")))
  242.     (let ((tail directory-abbrev-alist))
  243.       (while tail
  244.     (if (string-match (car (car tail)) default-directory)
  245.         (setq default-directory
  246.           (concat (cdr (car tail))
  247.               (substring default-directory (match-end 0)))))
  248.     (setq tail (cdr tail))))
  249.     (command-line)))
  250.  
  251.  
  252. (defun command-line-init ()
  253.   (let ((done nil))
  254.     ;; If user has not done su, use current $HOME to find .emacs.
  255.     (and init-file-user (string= init-file-user (user-real-login-name))
  256.      (setq init-file-user ""))
  257.     (while (and (not done) command-line-args-left)
  258.       (let ((argi (car command-line-args-left)))
  259.     (cond ((or (string-equal argi "-q")
  260.            (string-equal argi "-no-init-file"))
  261.            (setq init-file-user nil
  262.              command-line-args-left (cdr command-line-args-left)))
  263.           ((string-equal argi "-no-site-file")
  264.            (setq site-run-file nil
  265.              command-line-args-left (cdr command-line-args-left)))
  266.           ((or (string-equal argi "-u")
  267.            (string-equal argi "-user"))
  268.            (setq command-line-args-left (cdr command-line-args-left)
  269.              init-file-user (car command-line-args-left)
  270.              command-line-args-left (cdr command-line-args-left)))
  271.            (t (setq done t)))))
  272.     (let ((vc (getenv "VERSION_CONTROL")))
  273.       (and vc (cond
  274.            ((or (string= vc "t")
  275.             (string= vc "numbered"))
  276.         (setq version-control t))
  277.            ((or (string= vc "nil")
  278.             (string= vc "existing"))
  279.         (setq version-control nil))
  280.            ((or (string= vc "never")
  281.             (string= vc "simple"))
  282.         (setq version-control 'never)))))
  283.     ))
  284.  
  285.  
  286. (defun command-line ()
  287.   (let ((command-line-args-left (cdr command-line-args)))
  288.     (condition-case error
  289.       (progn
  290.     (set-default-load-path)
  291.     (setq init-file-user (if noninteractive nil (user-login-name)))
  292.     ;;
  293.     ;; When running emacs under a window system, the window-system-specific
  294.     ;; files are loaded and hooks are run before the user's init file is
  295.     ;; loaded; this is so that the user can see messages that the init file
  296.     ;; prints out, so that the init file can display buffers in windows,
  297.     ;; etc.
  298.     ;;
  299.     ;; When running emacs on a terminal, the terminal-specific files are
  300.     ;; loaded and hooks are run after the user's init file is loaded so
  301.     ;; that the user can override what file is loaded, and has a little
  302.     ;; more flexibility.
  303.     ;;
  304.     ;; The term-setup-hook is always run after the window and terminal
  305.     ;; initializations have happened and the user's init file has been
  306.     ;; loaded so that the user can customize things.
  307.     ;;
  308.     ;; Maybe this hairiness is pointless, and terminal initialization
  309.     ;; should work the same as window-system initialization; if this were
  310.     ;; the case, then there would be no need for the term-init-hook (the
  311.     ;; init file could do it directly.)
  312.     ;;
  313.     (if window-system (initialize-terminal-1))
  314.  
  315.     (if (and (eq window-system 'x)
  316.          (null (x-window-id (selected-screen))))
  317.         (premature-death-function
  318.     "Initialization error: Loading term/x-win.el didn't create an X screen!
  319. This probably means that this emacs is picking up an old (v18) lisp directory.
  320. "))
  321.     ;; process magic command-line switches like -q and -u.
  322.     (command-line-init)
  323.  
  324.     ;; initialize redisplay to make Fmessage() work.
  325.     (initialize-first-screen)
  326.     )
  327.       ;;
  328.       ;; If we get an error above, it's almost always because emacs couldn't
  329.       ;; find lisp/term/x-win.el, or it's loading the v18 lisp/term/x-win.el.
  330.       ;; If emacs supported ttys, then we could concievably continue here,
  331.       ;; and simply run in tty mode, but right now, that just causes the
  332.       ;; bogus "only runs under X" error to be printed.  Even when ttys work,
  333.       ;; there's not much point in trying to run if we know we're going to be
  334.       ;; so completely crippled.  It probably just won't work.
  335.       ;;
  336.       (error
  337.        (premature-death-function "Initialization error" error)))
  338.     ;;
  339.     ;; We have normality, I repeat, we have normality.  Anything you still
  340.     ;; can't cope with is therefore your own problem.  (And we don't need
  341.     ;; to kill emacs for it.)
  342.     ;;
  343.     (load-init-file)
  344.     
  345.     ;; If *scratch* exists and init file didn't change its mode, initialize it.
  346.     (if (get-buffer "*scratch*")
  347.     (save-excursion
  348.       (set-buffer "*scratch*")
  349.       (if (eq major-mode 'fundamental-mode)
  350.           (funcall initial-major-mode))))
  351.  
  352.     ;; Initialize terminal (not window system.)  See comment above.
  353.     (or window-system (initialize-terminal-1))
  354.     
  355.     ;; run user's terminal init hooks.
  356.     (initialize-terminal-2)
  357.     
  358.     ;; now process the rest of the command line, including user options.
  359.     (command-line-1)
  360.     
  361.     (if noninteractive (kill-emacs t))))
  362.  
  363.  
  364. ;;; Load user's init file and default ones.
  365. (defun load-init-file ()
  366.   (condition-case error
  367.       (progn
  368.      ;; load site-wide run-time init file first
  369.     (let ((inhibit-startup-message nil))
  370.       (and (stringp site-run-file)
  371.            (load site-run-file t t)))
  372.     (if init-file-user
  373.         (progn (load (if (eq system-type 'vax-vms)
  374.                  "sys$login:.emacs"
  375.                (concat "~" init-file-user "/.emacs"))
  376.              t t t)
  377.            (or inhibit-default-init
  378.                (let ((inhibit-startup-message nil))
  379.              ;; Users are supposed to be told their rights.
  380.              ;; (Plus how to get help and how to undo.)
  381.              ;; Don't you dare turn this off for anyone
  382.              ;; except yourself.
  383.              (load "default" t t))))))
  384.     (error (message "Error in init file: %s%s%s"
  385.             (get (car error) 'error-message)
  386.             (if (cdr error) ": ")
  387.             (mapconcat 'prin1-to-string (cdr error) ", ")))))
  388.  
  389. (defun initialize-terminal-1 ()
  390.   ;; Load library for our terminal type or window system.
  391.   ;; User init file can set term-file-prefix to nil to prevent this.
  392.   (and term-file-prefix (not noninteractive)
  393.        (if window-system
  394.        (load (concat term-file-prefix
  395.              (symbol-name window-system)
  396.              "-win")
  397.          ;; Every window system should have a startup file;
  398.          ;; barf if we can't find it.
  399.          nil t)
  400.      ;; else
  401.      (let ((term (getenv "TERM"))
  402.            hyphend)
  403.        (while (and term
  404.                (not (load (concat term-file-prefix term) t t)))
  405.          ;; Strip off last hyphen and what follows, then try again
  406.          (if (setq hyphend (string-match "[-_][^-_]+$" term))
  407.          (setq term (substring term 0 hyphend))
  408.            (setq term nil))))))
  409.  
  410.   ;; initialize the window system, create the first screen, etc.
  411.   (condition-case error
  412.       (and window-setup-hook
  413.        (run-hooks 'window-setup-hook))
  414.     (error
  415.      (premature-death-function "Error in window-setup-hook" error))))
  416.  
  417. (defun initialize-terminal-2 ()
  418.   ;; run the user's terminal init hooks.
  419.   (condition-case error
  420.       (and term-setup-hook
  421.        (run-hooks 'term-setup-hook))
  422.     (error (message "Error in term-setup-hook: %s%s%s"
  423.             (get (car error) 'error-message)
  424.             (if (cdr error) ": ")
  425.             (mapconcat 'prin1-to-string (cdr error) ", ")))))
  426.  
  427.  
  428. (defun command-line-1 ()
  429.   (if (null command-line-args-left)
  430.       (cond ((and (not inhibit-startup-message) (not noninteractive)
  431.           ;; Don't clobber a non-scratch buffer if init file
  432.           ;; has selected it.
  433.           (string= (buffer-name) "*scratch*")
  434.           (not (input-pending-p)))
  435.          (unwind-protect
  436.          (progn
  437.            (insert (emacs-version) "
  438. Copyright (C) 1990 Free Software Foundation, Inc.
  439. Copyright (C) 1990-1993 Lucid, Inc.
  440.  
  441. This version of Emacs is a part of Lucid's Energize Programming System,
  442. a C/C++ development environment.  Send mail to lucid-info@lucid.com for
  443. more information about Energize, or about Lucid Emacs support.")
  444.            ;; with the new Fwhere_is_internal(), this takes 0.02 secs.
  445.            (insert (substitute-command-keys
  446.        "\n\nType \\[help-command] for help; \\[advertised-undo] to undo changes.  (`C-' means use CTRL key.)
  447. To kill the Emacs job, type \\[save-buffers-kill-emacs].
  448. Type \\[help-with-tutorial] for a tutorial on using Emacs.
  449.  
  450. GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details.
  451. You may give out copies of Emacs; type \\[describe-copying] to see the conditions.
  452. Type \\[describe-distribution] for information on getting the latest version."))
  453.            (fontify-copyleft)
  454.            (set-buffer-modified-p nil)
  455.            (sit-for 120))
  456.            (save-excursion
  457.          ;; In case the Emacs server has already selected
  458.          ;; another buffer, erase the one our message is in.
  459.          (set-buffer (get-buffer "*scratch*"))
  460.          (erase-buffer)
  461.          (set-buffer-modified-p nil)))))
  462.     (let ((dir default-directory)
  463.       (file-count 0)
  464.       first-file-buffer
  465.       (line 0))
  466.       (while command-line-args-left
  467.     (let ((argi (car command-line-args-left))
  468.           tem)
  469.       (setq command-line-args-left (cdr command-line-args-left))
  470.       (cond ((setq tem (assoc argi command-switch-alist))
  471.          (funcall (cdr tem) argi))
  472.         ((string-match "^\\+[0-9]+\\'" argi)
  473.          (setq line (string-to-int argi)))
  474.         (t
  475.          (setq file-count (1+ file-count))
  476.          (cond ((= file-count 1)
  477.             (setq first-file-buffer
  478.                   (progn
  479.                 (find-file (expand-file-name argi dir))
  480.                 (current-buffer))))
  481.                (t
  482.             (find-file-other-window (expand-file-name argi dir))))
  483.          (or (zerop line)
  484.              (goto-line line))
  485.          (setq line 0)))))
  486.       ;; If 3 or more files visited, and not all visible, show user what
  487.       ;; they all are.
  488.       (if (> file-count 2)
  489.       (or (get-buffer-window first-file-buffer)
  490.           (progn (other-window 1)
  491.              (buffer-menu nil)))))))
  492.  
  493.  
  494. (defun find-emacs-root-internal (path)
  495.   (let ((dir (file-name-directory path))
  496.     (name (file-name-nondirectory path)))
  497.     (or
  498.      ;;
  499.      ;; If this directory is a plausible root of the emacs tree, return it.
  500.      ;;
  501.      (and (file-directory-p (expand-file-name "lisp/prim" dir))
  502.       (file-directory-p (expand-file-name "etc" dir))
  503.       dir)
  504.      ;;
  505.      ;; If the parent of this directory is a plausible root, use it.
  506.      ;; (But don't do so recursively!)
  507.      ;;
  508.      (and (file-directory-p (expand-file-name "../lisp/prim" dir))
  509.       (file-directory-p (expand-file-name "../etc" dir))
  510.       (expand-file-name "../" dir))
  511.      ;;
  512.      ;; If that doesn't work, and the emacs executable is a symlink, then
  513.      ;; chase the link and try again there.
  514.      ;;
  515.      (and (setq path (file-symlink-p path))
  516.       (find-emacs-root-internal (expand-file-name path dir)))
  517.      ;;
  518.      ;; Otherwise, this directory just doesn't cut it.
  519.      ;;
  520.      nil)))
  521.  
  522.  
  523. (defun set-default-load-path ()
  524.   (setq execution-path
  525.     ;; don't let /tmp_mnt/... get into the load-path or exec-path.
  526.     (abbreviate-file-name execution-path))
  527.  
  528.   (let* ((root (find-emacs-root-internal execution-path))
  529.      (lisp (and root (expand-file-name "lisp" root)))
  530.      (etc  (and root (expand-file-name "etc" root)))
  531.      (lock (and root (boundp 'lock-directory)
  532.             (file-name-as-directory
  533.              (or lock-directory (expand-file-name "lock" root))))))
  534.     (if lisp
  535.     (or (member lisp load-path)
  536.         (progn
  537.           ;; If the lisp dir isn't on the load-path, add it to the end.
  538.           (setq load-path (append load-path (list lisp)))
  539.           ;; If the lisp dir wasn't on the load-path, then also add any
  540.           ;; direct subdirectories of the lisp directory to the load-path.
  541.           ;; But don't add dirs whose names begin with dot or hyphen.
  542.           (let ((files (directory-files lisp nil "^[^-.]" nil 'dirs-only))
  543.             file)
  544.         (while files
  545.           (setq file (car files))
  546.           (if (and (not (member file '("RCS" "CVS")))
  547.                (setq file (expand-file-name file lisp))
  548.                (not (member file load-path)))
  549.               (setq load-path
  550.                 (nconc load-path
  551.                    (list (file-name-as-directory file)))))
  552.           (setq files (cdr files))))
  553.           )))
  554.     (if etc
  555.     (or (member etc exec-path)
  556.         (setq exec-path (append exec-path (list etc)))))
  557.     (if (and (null exec-directory) etc)
  558.     (setq exec-directory (file-name-as-directory etc)))
  559.     ;; Default the info dir to being a sibling of the exec-directory.
  560.     (if (and (boundp 'Info-directory-list) (null Info-directory-list))
  561.     (setq Info-directory-list
  562.           (list (expand-file-name "../info/" exec-directory))))
  563.     ;; Default the lock dir to being a sibling of the exec-directory.
  564.     ;; If superlock isn't set, derive it from the lock dir.
  565.     (if (boundp 'lock-directory)
  566.     (progn
  567.       (setq lock-directory lock)
  568.       (if (and lock-directory (null superlock-path))
  569.           (setq superlock-path
  570.             (concat lock-directory "!!!SuperLock!!!")))))
  571.     (set-default-load-path-warning)))
  572.  
  573.  
  574. (defun set-default-load-path-warning ()
  575.   (let ((lock (if (boundp 'lock-directory) lock-directory 't))
  576.     (fill-column 70)
  577.     warnings message guess)
  578.     (if (and (stringp lock) (not (file-directory-p lock)))
  579.     (setq lock nil))
  580.     (cond
  581.      ((not (and exec-directory load-path lock))
  582.       (save-excursion
  583.     (set-buffer (get-buffer-create " *warning-tmp*"))
  584.     (erase-buffer)
  585.     (buffer-disable-undo (current-buffer))
  586.     (if (null lock)
  587.         (setq warnings (cons "lock-directory" warnings)))
  588.     (if (null exec-directory)
  589.         (setq warnings (cons "exec-directory" warnings)))
  590.     (if (null load-path)
  591.         (setq warnings (cons "load-path" warnings)))
  592.     (cond ((cdr (cdr warnings))
  593.            (setq message (apply 'format "%s, %s, and %s" warnings)))
  594.           ((cdr warnings)
  595.            (setq message (apply 'format "%s and %s" warnings)))
  596.           (t (setq message (format "variable %s" (car warnings)))))
  597.     (insert "couldn't find an obvious default for " message
  598.         ", and there were no defaults specified in paths.h when emacs "
  599.         "was built.  Perhaps some directories don't exist, or the "
  600.         "emacs executable, " execution-path " is in a strange place?")
  601.     (setq guess (or exec-directory
  602.             (car (reverse load-path))
  603.             (and (string-match "/[^/]+$" execution-path)
  604.                  (substring execution-path 0
  605.                     (match-beginning 0)))))
  606.     (if (and guess (string-match "/\\(src\\|etc\\|lisp\\)/?$" guess))
  607.         (setq guess (substring guess 0 (match-beginning 0))))
  608.     (if (and guess (string-match "/$" guess))
  609.         (setq guess (substring guess 0 (match-beginning 0))))
  610.  
  611.     (if (or (null exec-directory) (null load-path))
  612.         (insert
  613.          "\n\nWithout both exec-directory and load-path, emacs will "
  614.          "be very broken.  "))
  615.     (if (and (null exec-directory) guess)
  616.         (insert
  617.          "Consider making a symbolic link from " guess
  618.          "/etc to wherever the appropriate emacs etc directory is"))
  619.     (if (and (null load-path) guess)
  620.         (insert
  621.          (if exec-directory "Consider making a symbolic link " ", and ")
  622.          "from " guess
  623.          "/lisp to wherever the appropriate emacs lisp library is.  ")
  624.       (if (and (null exec-directory) guess) (insert ".")))
  625.  
  626.     (if (null lock)
  627.         (progn
  628.           (insert
  629.            "\n\nWithout lock-directory set, file locking won't work.  ")
  630.           (if guess
  631.           (insert
  632.            "Consider creating " guess "/lock as a directory or "
  633.            "symbolic link for use as the lock directory.  "
  634.            "(This directory must be globally writable.)"))))
  635.  
  636.     (fill-region (point-min) (point-max))
  637.     (goto-char (point-min))
  638.     (princ "\nWARNING:\n" (function external-debugging-output))
  639.     (princ (buffer-string) (function external-debugging-output))
  640.     (erase-buffer)
  641.     t)))))
  642.  
  643.  
  644. (defvar cdlist nil)
  645.  
  646. (defun initialize-cdlist ()
  647.   (let ((cdpath (getenv "CDPATH"))
  648.     buf here end l)
  649.     (if cdpath
  650.     (save-excursion 
  651.       (setq buf (get-buffer-create "** cdpath-decode **"))
  652.       (set-buffer buf)
  653.       (erase-buffer)
  654.       (insert cdpath)
  655.       (insert ?:)
  656.       (goto-char (point-min))
  657.       (setq here (point)
  658.         end (point-max))
  659.       (while (< (point) (point-max))
  660.         (re-search-forward ":" end 33)
  661.         (setq l (cons (directory-file-name
  662.                (buffer-substring here (1- (point)))) l)
  663.           here (point)))
  664.       (nreverse l))
  665.       nil)))
  666.  
  667.  
  668. (defun fontify-copyleft ()
  669.   (and window-system (fboundp 'set-extent-face)
  670.        (save-excursion
  671.      (let ((case-fold-search nil))
  672.        (goto-char (point-min))
  673.        (while (re-search-forward
  674.            "\\b\\(C-[xh]\\( \\([CM]-\\)?.\\)?\\|M-x [-a-z]+\\)\\b"
  675.            nil t)
  676.          (set-extent-face (make-extent (match-beginning 0) (match-end 0))
  677.                   'bold))
  678.        (goto-char (point-min))
  679.        (while (re-search-forward "^Copyright[^\n]+$" nil t)
  680.          (set-extent-face (make-extent (match-beginning 0) (match-end 0))
  681.                   'bold-italic))
  682.        (goto-char (point-min))
  683.        (and (search-forward "ABSOLUTELY NO WARRANTY" nil t)
  684.         (set-extent-face
  685.          (make-extent (match-beginning 0) (match-end 0))
  686.          'italic))
  687.        (goto-char (point-min))
  688.        (and (search-forward "Energize Programming System" nil t)
  689.         (set-extent-face
  690.          (make-extent (match-beginning 0) (match-end 0))
  691.          'italic))
  692.        (and (re-search-forward "[-A-Za-z_]+@lucid\\.com" nil t)
  693.         (set-extent-face
  694.          (make-extent (match-beginning 0) (match-end 0))
  695.          'italic))
  696.        ))))
  697.