view lisp/paths.el @ 4677:8f1ee2d15784

Support full Common Lisp multiple values in C. lisp/ChangeLog 2009-08-11 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el : Update this file to support full C-level multiple values. This involves: -- Four new bytecodes, and special compiler functions to compile multiple-value-call, multiple-value-list-internal, values, values-list, and, since it now needs to pass back multiple values and is a special form, throw. -- There's a new compiler variable, byte-compile-checks-on-load, which is a list of forms that are evaluated at the very start of a file, with an error thrown if any of them give nil. -- The header is now inserted *after* compilation, giving a chance for the compilation process to influence what those checks are. There is still a check done before compilation for non-ASCII characters, to try to turn off dynamic docstrings if appopriate, in `byte-compile-maybe-reset-coding'. Space is reserved for checks; comments describing the version of the byte compiler generating the file are inserted if space remains for them. * bytecomp.el (byte-compile-version): Update this, we're a newer version of the byte compiler. * byte-optimize.el (byte-optimize-funcall): Correct a comment. * bytecomp.el (byte-compile-lapcode): Discard the arg with byte-multiple-value-call. * bytecomp.el (byte-compile-checks-and-comments-space): New variable, describe how many octets to reserve for checks at the start of byte-compiled files. * cl-compat.el: Remove the fake multiple-value implementation. Have the functions that use it use the real multiple-value implementation instead. * cl-macs.el (cl-block-wrapper, cl-block-throw): Revise the byte-compile properties of these symbols to work now we've made throw into a special form; keep the byte-compile properties as anonymous lambdas, since we don't have docstrings for them. * cl-macs.el (multiple-value-bind, multiple-value-setq) (multiple-value-list, nth-value): Update these functions to work with the C support for multiple values. * cl-macs.el (values): Modify the setf handler for this to call #'multiple-value-list-internal appropriately. * cl-macs.el (cl-setf-do-store): If the store form is a cons, treat it specially as wrapping the store value. * cl.el (cl-block-wrapper): Make this an alias of #'and, not #'identity, since it needs to pass back multiple values. * cl.el (multiple-value-apply): We no longer support this, mark it obsolete. * lisp-mode.el (eval-interactive-verbose): Remove a useless space in the docstring. * lisp-mode.el (eval-interactive): Update this function and its docstring. It now passes back a list, basically wrapping any eval calls with multiple-value-list. This allows multiple values to be printed by default in *scratch*. * lisp-mode.el (prin1-list-as-multiple-values): New function, printing a list as multiple values in the manner of Bruno Haible's clisp, separating each entry with " ;\n". * lisp-mode.el (eval-last-sexp): Call #'prin1-list-as-multiple-values on the return value of #'eval-interactive. * lisp-mode.el (eval-defun): Call #'prin1-list-as-multiple-values on the return value of #'eval-interactive. * mouse.el (mouse-eval-sexp): Deal with lists corresponding to multiple values from #'eval-interactive. Call #'cl-prettyprint, which is always available, instead of sometimes calling #'pprint and sometimes falling back to prin1. * obsolete.el (obsolete-throw): New function, called from eval.c when #'funcall encounters an attempt to call #'throw (now a special form) as a function. Only needed for compatibility with 21.4 byte-code. man/ChangeLog addition: 2009-08-11 Aidan Kehoe <kehoea@parhasard.net> * cl.texi (Organization): Remove references to the obsolete multiple-value emulating code. src/ChangeLog addition: 2009-08-11 Aidan Kehoe <kehoea@parhasard.net> * bytecode.c (enum Opcode /* Byte codes */): Add four new bytecodes, to deal with multiple values. (POP_WITH_MULTIPLE_VALUES): New macro. (POP): Modify this macro to ignore multiple values. (DISCARD_PRESERVING_MULTIPLE_VALUES): New macro. (DISCARD): Modify this macro to ignore multiple values. (TOP_WITH_MULTIPLE_VALUES): New macro. (TOP_ADDRESS): New macro. (TOP): Modify this macro to ignore multiple values. (TOP_LVALUE): New macro. (Bcall): Ignore multiple values where appropriate. (Breturn): Pass back multiple values. (Bdup): Preserve multiple values. Use TOP_LVALUE with most bytecodes that assign anything to anything. (Bbind_multiple_value_limits, Bmultiple_value_call, Bmultiple_value_list_internal, Bthrow): Implement the new bytecodes. (Bgotoifnilelsepop, Bgotoifnonnilelsepop, BRgotoifnilelsepop, BRgotoifnonnilelsepop): Discard any multiple values. * callint.c (Fcall_interactively): Ignore multiple values when calling #'eval, in two places. * device-x.c (x_IO_error_handler): * macros.c (pop_kbd_macro_event): * eval.c (Fsignal): * eval.c (flagged_a_squirmer): Call throw_or_bomb_out, not Fthrow, now that the latter is a special form. * eval.c: Make Qthrow, Qobsolete_throw available as symbols. Provide multiple_value_current_limit, multiple-values-limit (the latter as specified by Common Lisp. * eval.c (For): Ignore multiple values when comparing with Qnil, but pass any multiple values back for the last arg. * eval.c (Fand): Ditto. * eval.c (Fif): Ignore multiple values when examining the result of the condition. * eval.c (Fcond): Ignore multiple values when comparing what the clauses give, but pass them back if a clause gave non-nil. * eval.c (Fprog2): Never pass back multiple values. * eval.c (FletX, Flet): Ignore multiple when evaluating what exactly symbols should be bound to. * eval.c (Fwhile): Ignore multiple values when evaluating the test. * eval.c (Fsetq, Fdefvar, Fdefconst): Ignore multiple values. * eval.c (Fthrow): Declare this as a special form; ignore multiple values for TAG, preserve them for VALUE. * eval.c (throw_or_bomb_out): Make this available to other files, now Fthrow is a special form. * eval.c (Feval): Ignore multiple values when calling a compiled function, a non-special-form subr, or a lambda expression. * eval.c (Ffuncall): If we attempt to call #'throw (now a special form) as a function, don't error, call #'obsolete-throw instead. * eval.c (make_multiple_value, multiple_value_aset) (multiple_value_aref, print_multiple_value, mark_multiple_value) (size_multiple_value): Implement the multiple_value type. Add a long comment describing our implementation. * eval.c (bind_multiple_value_limits): New function, used by the bytecode and by #'multiple-value-call, #'multiple-value-list-internal. * eval.c (multiple_value_call): New function, used by the bytecode and #'multiple-value-call. * eval.c (Fmultiple_value_call): New special form. * eval.c (multiple_value_list_internal): New function, used by the byte code and #'multiple-value-list-internal. * eval.c (Fmultiple_value_list_internal, Fmultiple_value_prog1): New special forms. * eval.c (Fvalues, Fvalues_list): New Lisp functions. * eval.c (values2): New function, for C code returning multiple values. * eval.c (syms_of_eval): Make our new Lisp functions and symbols available. * eval.c (multiple-values-limit): Make this available to Lisp. * event-msw.c (dde_eval_string): * event-stream.c (execute_help_form): * glade.c (connector): * glyphs-widget.c (glyph_instantiator_to_glyph): * glyphs.c (evaluate_xpm_color_symbols): * gui-x.c (wv_set_evalable_slot, button_item_to_widget_value): * gui.c (gui_item_value, gui_item_display_flush_left): * lread.c (check_if_suppressed): * menubar-gtk.c (menu_convert, menu_descriptor_to_widget_1): * menubar-msw.c (populate_menu_add_item): * print.c (Fwith_output_to_temp_buffer): * symbols.c (Fsetq_default): Ignore multiple values when calling Feval. * symeval.h: Add the header declarations necessary for the multiple-values implementation. * inline.c: #include symeval.h, now that it has some inline functions. * lisp.h: Update Fthrow's declaration. Make throw_or_bomb_out available to all files. * lrecord.h (enum lrecord_type): Add the multiple_value type here.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 16 Aug 2009 20:55:49 +0100
parents 576fb035e263
children aa5ed11f473b
line wrap: on
line source

;;; paths.el --- define pathnames for use by various Emacs commands.

;; Copyright (C) 1986, 1988, 1993, 1994, 1997 Free Software Foundation, Inc.

;; Maintainer: FSF
;; Keywords: internal, dumped

;; This file is part of XEmacs.

;; XEmacs 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.

;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Synched up with: FSF 19.30.

;;; Commentary:

;; This file is dumped with XEmacs.

;; These are default settings for names of certain files and directories
;; that Emacs needs to refer to from time to time.

;; If these settings are not right, override them with `setq'
;; in site-start.el.  Do not change this file.

;;; Code:

;Note: FSF's version is:
;(defvar Info-default-directory-list
;  (let ((start (list "/usr/local/lib/info/"
;		      ;; This comes second so that, if it is the same
;		      ;; as configure-info-directory (which is usually true)
;		      ;; and Emacs has been installed (also usually true)
;		      ;; then the list will end with two copies of this;
;		      ;; which means that the last dir file Info-insert-dir
;		      ;; finds will be the one in this directory.
;		      "/usr/local/info/"))
;	 (configdir (file-name-as-directory configure-info-directory)))
;    (setq start (nconc start (list configdir)))
;    start)
;  "List of directories to search for Info documentation files.
;They are searched in the order they are given in this list.
;Therefore, the directory of Info files that come with Emacs
;normally should come last (so that local files override standard ones).")

;Our commented-out version is:
;(defvar Info-default-directory-list
;  (let ((start (list "/usr/local/info/"
;		     "/usr/local/lib/info/"))
;	(configdir (file-name-as-directory configure-info-directory)))
;    (or (member configdir start)
;	(setq start (nconc start (list configdir))))
;    (or (member (expand-file-name "../info/" data-directory) start)
;	(setq start
;	      (nconc start
;		     (list (expand-file-name "../info/" data-directory)))))
;    start)
;  "List of directories to search for Info documentation files.")

(defvar news-path "/usr/spool/news/"
  "The root directory below which all news files are stored.")

(defvar news-inews-program nil
  "Program to post news.")

;(defvar gnus-default-nntp-server ""
;  ;; set this to your local server
;  "The name of the host running an NNTP server.
;If it is a string such as \":DIRECTORY\", then ~/DIRECTORY
;is used as a news spool.  `gnus-nntp-server' is initialized from NNTPSERVER
;environment variable or, if none, this value.")

;(defvar gnus-nntp-service "nntp"
;  "NNTP service name, usually \"nntp\" or 119).
;Go to a local news spool if its value is nil, in which case `gnus-nntp-server'
;should be set to `(system-name)'.")

(defvar mh-progs nil
  "Directory containing MH commands.")

(defvar mh-lib nil
  "Directory of MH library.")

(defvar rmail-file-name "~/RMAIL"
  "Name of user's primary mail file.")

(defconst rmail-spool-directory nil
  "Name of directory used by system mailer for delivering new mail.
Its name should end with a slash.")

(defconst sendmail-program nil
  "Program used to send messages.")

(defconst remote-shell-program nil
  "Program used to execute shell commands on a remote machine.")

(defconst term-file-prefix "term/"
  "If non-nil, Emacs startup does (load (concat term-file-prefix (getenv \"TERM\")))
You may set this variable to nil in your `.emacs' file if you do not wish
the terminal-initialization file to be loaded.")

(defconst manual-program nil
  "Program to run to print man pages.")

(defconst abbrev-file-name "~/.abbrev_defs"
  "*Default name of file to read abbrevs from.")

(defconst directory-abbrev-alist nil)

;; Formerly, the values of these variables were computed once
;; (at dump time).  However, with the advent of pre-compiled binaries
;; and homebrewed systems such as Linux where who knows where the
;; hell the various programs may be located (if they even exist at all),
;; it's clear that we need to recompute these values at run time.
;; In typical short-sightedness, site administrators have been told up
;; till now to do `setq's in site-init.el, which is run only once --
;; at dump time.  So we have to do contortions to make sure we don't
;; override values set in site-init.el.

(defun initialize-xemacs-paths ()
  "Initialize the XEmacs path variables from the environment.
Called automatically at dump time and run time.  Do not call this.
Will not override settings in site-init.el or site-run.el."
  (let ((l #'(lambda (var value)
	       (let ((origsym (intern (concat "paths-el-original-"
					      (symbol-name var)))))
		 (if (running-temacs-p)
		     (progn
		       (set var value)
		       (set origsym value))
		   (and (eq (symbol-value var) (symbol-value origsym))
			(set var value)))))))
    (funcall
     l 'news-inews-program
     (cond ((file-exists-p "/usr/bin/inews") "/usr/bin/inews")
	   ((file-exists-p "/usr/local/inews") "/usr/local/inews")
	   ((file-exists-p "/usr/local/bin/inews") "/usr/local/bin/inews")
	   ((file-exists-p "/usr/lib/news/inews") "/usr/lib/news/inews")
	   (t "inews")))

    (funcall
     l 'mh-progs
     (cond ((file-directory-p "/usr/bin/mh") "/usr/bin/mh/") ;Ultrix 4.2
	   ((file-directory-p "/usr/new/mh") "/usr/new/mh/") ;Ultrix <4.2
	   ((file-directory-p "/usr/local/bin/mh") "/usr/local/bin/mh/")
	   ((file-directory-p "/usr/local/mh") "/usr/local/mh/")
	   (t "/usr/local/bin/")))

    (funcall
     l 'mh-libs
     (cond ((file-directory-p "/usr/lib/mh") "/usr/lib/mh/") ;Ultrix 4.2
	   ((file-directory-p "/usr/new/lib/mh")
	    "/usr/new/lib/mh/") ;Ultrix <4.2
	   ((file-directory-p "/usr/local/lib/mh") "/usr/local/lib/mh/")
	   (t "/usr/local/bin/mh/")))

    (funcall
     l 'rmail-spool-directory
     (cond ((string-match "^[^-]+-[^-]+-sco3.2v4" system-configuration)
	    "/usr/spool/mail/")
	   ;; On The Bull DPX/2 /usr/spool/mail is used although
	   ;; it is usg-unix-v.
	   ((string-match "^m68k-bull-sysv3" system-configuration)
	    "/usr/spool/mail/")
	   ;; SVR4 and recent BSD are said to use this.
	   ;; Rather than trying to know precisely which systems use it,
	   ;; let's assume this dir is never used for anything else.
	   ((file-exists-p "/var/mail")
	    "/var/mail/")
	   ((memq system-type '(dgux hpux usg-unix-v unisoft-unix rtu irix))
	    "/usr/mail/")
	   ((memq system-type '(linux))
	    "/var/spool/mail/")
	   (t "/usr/spool/mail/")))

    (funcall
     l 'sendmail-program
     (cond
      ((file-exists-p "/usr/lib/sendmail") "/usr/lib/sendmail")
      ((file-exists-p "/usr/sbin/sendmail") "/usr/sbin/sendmail")
      ((file-exists-p "/usr/ucblib/sendmail") "/usr/ucblib/sendmail")
      (t "fakemail")))		;In ../etc, to interface to /bin/mail.

    (funcall
     l 'remote-shell-program
     (cond
      ;; Some systems use rsh for the remote shell; others use that
      ;; name for the restricted shell and use remsh for the remote
      ;; shell.  Let's try to guess based on what we actually find
      ;; out there.  The restricted shell is almost certainly in
      ;; /bin or /usr/bin, so it's probably safe to assume that an
      ;; rsh found elsewhere is the remote shell program.  The
      ;; converse is not true: /usr/bin/rsh could be either one, so
      ;; check that last.
      ((file-exists-p "/usr/ucb/remsh") "/usr/ucb/remsh")
      ((file-exists-p "/usr/bsd/remsh") "/usr/bsd/remsh")
      ((file-exists-p "/bin/remsh") "/bin/remsh")
      ((file-exists-p "/usr/bin/remsh") "/usr/bin/remsh")
      ((file-exists-p "/usr/local/bin/remsh") "/usr/local/bin/remsh")
      ((file-exists-p "/usr/ucb/rsh") "/usr/ucb/rsh")
      ((file-exists-p "/usr/bsd/rsh") "/usr/bsd/rsh")
      ((file-exists-p "/usr/local/bin/rsh") "/usr/local/bin/rsh")
      ((file-exists-p "/usr/bin/rcmd") "/usr/bin/rcmd")
      ((file-exists-p "/bin/rcmd") "/bin/rcmd")
      ((file-exists-p "/bin/rsh") "/bin/rsh")
      ((file-exists-p "/usr/bin/rsh") "/usr/bin/rsh")
      (t "rsh")))

    (funcall
     l 'manual-program
     ;; Solaris 2 has both of these files; prefer /usr/ucb/man
     ;; because the other has nonstandard argument conventions.
     (if (file-exists-p "/usr/ucb/man")
	 "/usr/ucb/man" "/usr/bin/man"))

    (funcall
     l 'directory-abbrev-alist
     ;; Try to match various conventions for automounter temporary
     ;; mount points.  These temporary mount points may go away, so
     ;; it's important that we only try to read files under the
     ;; "advertised" mount point, rather than the temporary one, or it
     ;; will look like files have been deleted on us.  Whoever came up
     ;; with this design is clearly a moron of the first order, but
     ;; now we're stuck with it, no doubt until the end of time.
     ;;
     ;; For best results, automounter junk should go near the front of this
     ;; list, and other user translations should come after it.
     ;;
     ;; Our code handles the following empirically observed conventions:
     ;; /net is an actual directory! (some systems are not broken!)
     ;; /net/HOST -> /tmp_mnt/net/HOST (`standard' old Sun automounter)
     ;; /net/HOST -> /tmp_mnt/HOST (BSDI 4.0)
     ;; /net/HOST -> /a/HOST (Freebsd 2.2.x)
     ;; /net/HOST -> /amd/HOST (seen in amd sample config files)
     ;;
     ;; If your system has a different convention, you may have to change this.
     ;; Don't forget to send in a patch!
     (when (file-directory-p "/net")
       (append
	(when (file-directory-p "/tmp_mnt")
	  (if (file-directory-p "/tmp_mnt/net")
	      '(("\\`/tmp_mnt/net/" . "/net/"))
	    '(("\\`/tmp_mnt/" . "/net/"))))
	(when (file-directory-p "/a")
	  '(("\\`/a/" . "/net/")))
	(when (file-directory-p "/amd")
	  '(("\\`/amd/" . "/net/")))
	)))
))

(if (running-temacs-p)
    (initialize-xemacs-paths))

;;; paths.el ends here