mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-24 10:38:38 +00:00
Merge from mainline.
This commit is contained in:
Paul Eggert
commit
852a74a59b
@ -1,4 +1,4 @@
|
||||
2011-05-04 Paul Eggert <eggert@cs.ucla.edu>
|
||||
2011-05-05 Paul Eggert <eggert@cs.ucla.edu>
|
||||
|
||||
Use C99's va_copy to avoid undefined behavior on x86-64 GNU/Linux.
|
||||
* Makefile.in (GNULIB_MODULES): Add stdarg, for va_copy.
|
||||
@ -8,10 +8,13 @@
|
||||
This new gnulib-tool option saves 'configure' the trouble of
|
||||
checking for strtoull when strtoumax exists.
|
||||
|
||||
2011-04-29 Paul Eggert <eggert@cs.ucla.edu>
|
||||
|
||||
* configure.in (BITS_PER_LONG_LONG): New macro.
|
||||
|
||||
2011-05-05 Glenn Morris <rgm@gnu.org>
|
||||
|
||||
* Makefile.in (bootstrap-clean): Save config.log. (Bug#765)
|
||||
(top_distclean): Delete config.log~.
|
||||
|
||||
2011-04-27 Ben Key <bkey76@gmail.com>
|
||||
|
||||
* configure.in: Fixed a bug that caused configure with
|
||||
|
||||
@ -799,7 +799,7 @@ top_bootclean=\
|
||||
### distribution.
|
||||
top_distclean=\
|
||||
${top_bootclean}; \
|
||||
rm -f config.status Makefile stamp-h1 ${SUBDIR_MAKEFILES}
|
||||
rm -f config.status config.log~ Makefile stamp-h1 ${SUBDIR_MAKEFILES}
|
||||
distclean: FRC
|
||||
(cd src; $(MAKE) $(MFLAGS) distclean)
|
||||
(cd oldXMenu; $(MAKE) $(MFLAGS) distclean)
|
||||
@ -829,7 +829,10 @@ bootstrap-clean: FRC
|
||||
-(cd doc/lispintro && $(MAKE) $(MFLAGS) maintainer-clean)
|
||||
(cd leim; $(MAKE) $(MFLAGS) maintainer-clean)
|
||||
(cd lisp; $(MAKE) $(MFLAGS) bootstrap-clean)
|
||||
[ ! -e config.log ] || mv -f config.log config.log~
|
||||
${top_bootclean}
|
||||
## configure; make bootstrap replaces the real config.log from configure
|
||||
## with the truncated one from config.status. The former is more useful.
|
||||
|
||||
### `maintainer-clean'
|
||||
### Delete everything from the current directory that can be
|
||||
@ -928,6 +931,8 @@ dvi:
|
||||
|
||||
.PHONY: bootstrap
|
||||
|
||||
## configure; make boostrap replaces the real config.log from configure
|
||||
## with the truncated one from config.status. The former is more useful.
|
||||
bootstrap: bootstrap-clean FRC
|
||||
if [ -x ./config.status ]; then \
|
||||
./config.status; \
|
||||
|
||||
21
etc/NEWS.23
21
etc/NEWS.23
@ -15,11 +15,7 @@ You can narrow news to a specific version by calling `view-emacs-news'
|
||||
with a prefix argument or by typing C-u C-h C-n.
|
||||
|
||||
|
||||
* Installation Changes in Emacs 23.3
|
||||
|
||||
** New configure option --with-crt-dir specifies the location of your
|
||||
crt*.o files, if they are in a non-standard location. This is only
|
||||
used on x86-64 and s390x GNU/Linux architectures.
|
||||
* Installation Changes in Emacs 23.4
|
||||
|
||||
** The MS-Windows build prefers libpng version 1.14 or later.
|
||||
Versions of libpng before 1.14 had security issues, so we now
|
||||
@ -28,6 +24,21 @@ require version 1.14 or later. See README.W32 and nt/INSTALL for
|
||||
details and pointers to URLs where the latest libpng can be
|
||||
downloaded.
|
||||
|
||||
|
||||
* Changes in Emacs 23.4 on non-free operating systems
|
||||
|
||||
** The MS-Windows port can now use more than 500MB of heap.
|
||||
Depending on the available virtual memory, Emacs on Windows can now
|
||||
have up to 2GB of heap space. This allows, e.g., to visit several
|
||||
large (> 256MB) files in the same session.
|
||||
|
||||
|
||||
* Installation Changes in Emacs 23.3
|
||||
|
||||
** New configure option --with-crt-dir specifies the location of your
|
||||
crt*.o files, if they are in a non-standard location. This is only
|
||||
used on x86-64 and s390x GNU/Linux architectures.
|
||||
|
||||
* Changes in Emacs 23.3
|
||||
|
||||
** The last-resort backup file `%backup%~' is now written to
|
||||
|
||||
@ -1,3 +1,11 @@
|
||||
2011-05-05 Eli Zaretskii <eliz@gnu.org>
|
||||
|
||||
* quail/latin-ltx.el <\beth, \gimel, \daleth>: Produce
|
||||
corresponding symbols rather than Hebrew letters. (Bug#8563)
|
||||
|
||||
* quail/latin-ltx.el <\aleph>: Produce ALEF SYMBOL instead of
|
||||
HEBREW LETTER ALEF. (Bug#8563)
|
||||
|
||||
2011-03-23 Glenn Morris <rgm@gnu.org>
|
||||
|
||||
* Makefile.in (install): Use `install-sh -d' rather than mkinstalldirs.
|
||||
|
||||
@ -498,7 +498,7 @@ system, including many technical ones. Examples:
|
||||
("\\Vert" ?‖)
|
||||
("\\Vvdash" ?⊪)
|
||||
("\\Xi" ?Ξ)
|
||||
("\\aleph" ?א)
|
||||
("\\aleph" ?ℵ)
|
||||
("\\alpha" ?α)
|
||||
("\\amalg" ?∐)
|
||||
("\\angle" ?∠)
|
||||
@ -515,7 +515,7 @@ system, including many technical ones. Examples:
|
||||
("\\barwedge" ?⊼)
|
||||
("\\because" ?∵)
|
||||
("\\beta" ?β)
|
||||
("\\beth" ?ב)
|
||||
("\\beth" ?ℶ)
|
||||
("\\between" ?≬)
|
||||
("\\bigcap" ?⋂)
|
||||
("\\bigcirc" ?◯)
|
||||
@ -569,7 +569,7 @@ system, including many technical ones. Examples:
|
||||
|
||||
("\\dag" ?†)
|
||||
("\\dagger" ?†)
|
||||
("\\daleth" ?ד)
|
||||
("\\daleth" ?ℸ)
|
||||
("\\dashv" ?⊣)
|
||||
("\\ddag" ?‡)
|
||||
("\\ddagger" ?‡)
|
||||
@ -626,7 +626,7 @@ system, including many technical ones. Examples:
|
||||
("\\gets" ?←)
|
||||
("\\gg" ?≫)
|
||||
("\\ggg" ?⋙)
|
||||
("\\gimel" ?ג)
|
||||
("\\gimel" ?ℷ)
|
||||
("\\gnapprox" ?⋧)
|
||||
("\\gneq" ?≩)
|
||||
("\\gneqq" ?≩)
|
||||
|
||||
@ -1,3 +1,44 @@
|
||||
2011-05-05 Daniel Colascione <dan.colascione@gmail.com>
|
||||
|
||||
* progmodes/cc-engine.el (c-forward-decl-or-cast-1): Use
|
||||
correct match group (bug#8438).
|
||||
|
||||
2011-05-05 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
Fix earlier half-done eieio-defmethod change (bug#8338).
|
||||
* emacs-lisp/eieio.el (eieio--defmethod): Rename from eieio-defmethod.
|
||||
Streamline and change calling convention.
|
||||
(defmethod): Adjust accordingly and simplify.
|
||||
(eieio-defclass): Fix broken calls to eieio-defmethod and redirect to
|
||||
new eieio--defmethod.
|
||||
(slot-boundp): Minor CSE simplification.
|
||||
|
||||
2011-05-05 Milan Zamazal <pdm@zamazal.org>
|
||||
|
||||
* progmodes/glasses.el (glasses-separate-capital-groups): New option.
|
||||
(glasses-make-readable): Use glasses-separate-capital-groups.
|
||||
|
||||
2011-05-05 Juanma Barranquero <lekktu@gmail.com>
|
||||
|
||||
* emacs-lisp/warnings.el (warning-level-aliases): Reflow docstring.
|
||||
(warning-series): Doc fix.
|
||||
(display-warning): Don't try to create the buffer if we just found it.
|
||||
|
||||
2011-05-04 Chong Yidong <cyd@stupidchicken.com>
|
||||
|
||||
* emacs-lisp/autoload.el (generated-autoload-file): Set to nil.
|
||||
(autoload-find-generated-file): New function.
|
||||
(generate-file-autoloads): Bind generated-autoload-file to
|
||||
buffer-file-name.
|
||||
(update-file-autoloads, update-directory-autoloads):
|
||||
Use autoload-find-generated-file. If called interactively, prompt for
|
||||
output file (Bug#7989).
|
||||
(batch-update-autoloads): Doc fix.
|
||||
|
||||
2011-05-04 Juanma Barranquero <lekktu@gmail.com>
|
||||
|
||||
* term/w32-win.el (dynamic-library-alist): Add `gnutls'.
|
||||
|
||||
2011-05-04 Glenn Morris <rgm@gnu.org>
|
||||
|
||||
* calendar/diary-lib.el (diary-fancy-date-pattern): Turn it into a
|
||||
|
||||
@ -34,8 +34,8 @@
|
||||
(require 'help-fns) ;for help-add-fundoc-usage.
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(defvar generated-autoload-file "loaddefs.el"
|
||||
"File \\[update-file-autoloads] puts autoloads into.
|
||||
(defvar generated-autoload-file nil
|
||||
"File into which to write autoload definitions.
|
||||
A Lisp file can set this in its local variables section to make
|
||||
its autoloads go somewhere else.
|
||||
|
||||
@ -198,6 +198,15 @@ or macro definition or a defcustom)."
|
||||
;; the doc-string in FORM.
|
||||
;; Those properties are now set in lisp-mode.el.
|
||||
|
||||
(defun autoload-find-generated-file ()
|
||||
"Visit the autoload file for the current buffer, and return its buffer.
|
||||
If a buffer is visiting the desired autoload file, return it."
|
||||
(let ((enable-local-variables :safe))
|
||||
;; We used to use `raw-text' to read this file, but this causes
|
||||
;; problems when the file contains non-ASCII characters.
|
||||
(find-file-noselect
|
||||
(autoload-ensure-default-file (autoload-generated-file)))))
|
||||
|
||||
(defun autoload-generated-file ()
|
||||
(expand-file-name generated-autoload-file
|
||||
;; File-local settings of generated-autoload-file should
|
||||
@ -389,7 +398,8 @@ If FILE is being visited in a buffer, the contents of the buffer
|
||||
are used.
|
||||
Return non-nil in the case where no autoloads were added at point."
|
||||
(interactive "fGenerate autoloads for file: ")
|
||||
(autoload-generate-file-autoloads file (current-buffer)))
|
||||
(let ((generated-autoload-file buffer-file-name))
|
||||
(autoload-generate-file-autoloads file (current-buffer))))
|
||||
|
||||
(defvar print-readably)
|
||||
|
||||
@ -550,15 +560,22 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE
|
||||
(save-buffer)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun update-file-autoloads (file &optional save-after)
|
||||
"Update the autoloads for FILE in `generated-autoload-file'
|
||||
\(which FILE might bind in its local variables).
|
||||
If SAVE-AFTER is non-nil (which is always, when called interactively),
|
||||
save the buffer too.
|
||||
(defun update-file-autoloads (file &optional save-after outfile)
|
||||
"Update the autoloads for FILE.
|
||||
If prefix arg SAVE-AFTER is non-nil, save the buffer too.
|
||||
|
||||
If FILE binds `generated-autoload-file' as a file-local variable,
|
||||
autoloads are written into that file. Otherwise, the autoloads
|
||||
file is determined by OUTFILE. If called interactively, prompt
|
||||
for OUTFILE; if called from Lisp with OUTFILE nil, use the
|
||||
existing value of `generated-autoload-file'.
|
||||
|
||||
Return FILE if there was no autoload cookie in it, else nil."
|
||||
(interactive "fUpdate autoloads for file: \np")
|
||||
(let* ((autoload-modified-buffers nil)
|
||||
(interactive (list (read-file-name "Update autoloads for file: ")
|
||||
current-prefix-arg
|
||||
(read-file-name "Write autoload definitions to file: ")))
|
||||
(let* ((generated-autoload-file (or outfile generated-autoload-file))
|
||||
(autoload-modified-buffers nil)
|
||||
(no-autoloads (autoload-generate-file-autoloads file)))
|
||||
(if autoload-modified-buffers
|
||||
(if save-after (autoload-save-buffers))
|
||||
@ -576,12 +593,7 @@ removes any prior now out-of-date autoload entries."
|
||||
(let* ((buf (current-buffer))
|
||||
(existing-buffer (if buffer-file-name buf))
|
||||
(found nil))
|
||||
(with-current-buffer
|
||||
;; We used to use `raw-text' to read this file, but this causes
|
||||
;; problems when the file contains non-ASCII characters.
|
||||
(let ((enable-local-variables :safe))
|
||||
(find-file-noselect
|
||||
(autoload-ensure-default-file (autoload-generated-file))))
|
||||
(with-current-buffer (autoload-find-generated-file)
|
||||
;; This is to make generated-autoload-file have Unix EOLs, so
|
||||
;; that it is portable to all platforms.
|
||||
(or (eq 0 (coding-system-eol-type buffer-file-coding-system))
|
||||
@ -640,15 +652,20 @@ removes any prior now out-of-date autoload entries."
|
||||
|
||||
;;;###autoload
|
||||
(defun update-directory-autoloads (&rest dirs)
|
||||
"\
|
||||
Update loaddefs.el with all the current autoloads from DIRS, and no old ones.
|
||||
This uses `update-file-autoloads' (which see) to do its work.
|
||||
In an interactive call, you must give one argument, the name
|
||||
of a single directory. In a call from Lisp, you can supply multiple
|
||||
"Update autoload definitions for Lisp files in the directories DIRS.
|
||||
In an interactive call, you must give one argument, the name of a
|
||||
single directory. In a call from Lisp, you can supply multiple
|
||||
directories as separate arguments, but this usage is discouraged.
|
||||
|
||||
The function does NOT recursively descend into subdirectories of the
|
||||
directory or directories specified."
|
||||
directory or directories specified.
|
||||
|
||||
In an interactive call, prompt for a default output file for the
|
||||
autoload definitions, and temporarily bind the variable
|
||||
`generated-autoload-file' to this value. When called from Lisp,
|
||||
use the existing value of `generated-autoload-file'. If any Lisp
|
||||
file binds `generated-autoload-file' as a file-local variable,
|
||||
write its autoloads into the specified file instead."
|
||||
(interactive "DUpdate autoloads from directory: ")
|
||||
(let* ((files-re (let ((tmp nil))
|
||||
(dolist (suf (get-load-suffixes)
|
||||
@ -664,14 +681,14 @@ directory or directories specified."
|
||||
;; Files with no autoload cookies or whose autoloads go to other
|
||||
;; files because of file-local autoload-generated-file settings.
|
||||
(no-autoloads nil)
|
||||
(autoload-modified-buffers nil))
|
||||
(autoload-modified-buffers nil)
|
||||
(generated-autoload-file
|
||||
(if (called-interactively-p 'interactive)
|
||||
(read-file-name "Write autoload definitions to file: ")
|
||||
generated-autoload-file)))
|
||||
|
||||
(with-current-buffer
|
||||
(let ((enable-local-variables :safe))
|
||||
(find-file-noselect
|
||||
(autoload-ensure-default-file (autoload-generated-file))))
|
||||
(with-current-buffer (autoload-find-generated-file)
|
||||
(save-excursion
|
||||
|
||||
;; Canonicalize file names and remove the autoload file itself.
|
||||
(setq files (delete (file-relative-name buffer-file-name)
|
||||
(mapcar 'file-relative-name files)))
|
||||
@ -748,7 +765,9 @@ directory or directories specified."
|
||||
;;;###autoload
|
||||
(defun batch-update-autoloads ()
|
||||
"Update loaddefs.el autoloads in batch mode.
|
||||
Calls `update-directory-autoloads' on the command line arguments."
|
||||
Calls `update-directory-autoloads' on the command line arguments.
|
||||
Definitions are written to `generated-autoload-file' (which
|
||||
should be non-nil)."
|
||||
;; For use during the Emacs build process only.
|
||||
(unless autoload-excludes
|
||||
(let* ((ldir (file-name-directory generated-autoload-file))
|
||||
|
||||
@ -656,14 +656,14 @@ See `defclass' for more information."
|
||||
;; so that users can `setf' the space returned by this function
|
||||
(if acces
|
||||
(progn
|
||||
(eieio-defmethod acces
|
||||
(list (if (eq alloc :class) :static :primary)
|
||||
(list (list 'this cname))
|
||||
(format
|
||||
(eieio--defmethod
|
||||
acces (if (eq alloc :class) :static :primary) cname
|
||||
`(lambda (this)
|
||||
,(format
|
||||
"Retrieves the slot `%s' from an object of class `%s'"
|
||||
name cname)
|
||||
(list 'if (list 'slot-boundp 'this (list 'quote name))
|
||||
(list 'eieio-oref 'this (list 'quote name))
|
||||
(if (slot-boundp this ',name)
|
||||
(eieio-oref this ',name)
|
||||
;; Else - Some error? nil?
|
||||
nil)))
|
||||
|
||||
@ -683,22 +683,21 @@ See `defclass' for more information."
|
||||
;; If a writer is defined, then create a generic method of that
|
||||
;; name whose purpose is to set the value of the slot.
|
||||
(if writer
|
||||
(progn
|
||||
(eieio-defmethod writer
|
||||
(list (list (list 'this cname) 'value)
|
||||
(format "Set the slot `%s' of an object of class `%s'"
|
||||
(eieio--defmethod
|
||||
writer nil cname
|
||||
`(lambda (this value)
|
||||
,(format "Set the slot `%s' of an object of class `%s'"
|
||||
name cname)
|
||||
`(setf (slot-value this ',name) value)))
|
||||
))
|
||||
(setf (slot-value this ',name) value))))
|
||||
;; If a reader is defined, then create a generic method
|
||||
;; of that name whose purpose is to access this slot value.
|
||||
(if reader
|
||||
(progn
|
||||
(eieio-defmethod reader
|
||||
(list (list (list 'this cname))
|
||||
(format "Access the slot `%s' from object of class `%s'"
|
||||
(eieio--defmethod
|
||||
reader nil cname
|
||||
`(lambda (this)
|
||||
,(format "Access the slot `%s' from object of class `%s'"
|
||||
name cname)
|
||||
`(slot-value this ',name)))))
|
||||
(slot-value this ',name))))
|
||||
)
|
||||
(setq slots (cdr slots)))
|
||||
|
||||
@ -1290,83 +1289,48 @@ Summary:
|
||||
((typearg class-name) arg2 &optional opt &rest rest)
|
||||
\"doc-string\"
|
||||
body)"
|
||||
(let* ((key (cond ((or (eq ':BEFORE (car args))
|
||||
(eq ':before (car args)))
|
||||
(setq args (cdr args))
|
||||
:before)
|
||||
((or (eq ':AFTER (car args))
|
||||
(eq ':after (car args)))
|
||||
(setq args (cdr args))
|
||||
:after)
|
||||
((or (eq ':PRIMARY (car args))
|
||||
(eq ':primary (car args)))
|
||||
(setq args (cdr args))
|
||||
:primary)
|
||||
((or (eq ':STATIC (car args))
|
||||
(eq ':static (car args)))
|
||||
(setq args (cdr args))
|
||||
:static)
|
||||
(t nil)))
|
||||
(let* ((key (if (keywordp (car args)) (pop args)))
|
||||
(params (car args))
|
||||
(lamparams
|
||||
(mapcar (lambda (param) (if (listp param) (car param) param))
|
||||
params))
|
||||
(arg1 (car params))
|
||||
(class (if (listp arg1) (nth 1 arg1) nil)))
|
||||
`(eieio-defmethod ',method
|
||||
'(,@(if key (list key))
|
||||
,params)
|
||||
(lambda ,lamparams ,@(cdr args)))))
|
||||
(class (if (consp arg1) (nth 1 arg1))))
|
||||
`(eieio--defmethod ',method ',key ',class
|
||||
(lambda ,(if (consp arg1)
|
||||
(cons (car arg1) (cdr params))
|
||||
params)
|
||||
,@(cdr args)))))
|
||||
|
||||
(defun eieio-defmethod (method args &optional code)
|
||||
(defun eieio--defmethod (method kind argclass code)
|
||||
"Work part of the `defmethod' macro defining METHOD with ARGS."
|
||||
(let ((key nil) (body nil) (firstarg nil) (argfix nil) (argclass nil) loopa)
|
||||
(let ((key
|
||||
;; find optional keys
|
||||
(setq key
|
||||
(cond ((or (eq ':BEFORE (car args))
|
||||
(eq ':before (car args)))
|
||||
(setq args (cdr args))
|
||||
(cond ((or (eq ':BEFORE kind)
|
||||
(eq ':before kind))
|
||||
method-before)
|
||||
((or (eq ':AFTER (car args))
|
||||
(eq ':after (car args)))
|
||||
(setq args (cdr args))
|
||||
((or (eq ':AFTER kind)
|
||||
(eq ':after kind))
|
||||
method-after)
|
||||
((or (eq ':PRIMARY (car args))
|
||||
(eq ':primary (car args)))
|
||||
(setq args (cdr args))
|
||||
((or (eq ':PRIMARY kind)
|
||||
(eq ':primary kind))
|
||||
method-primary)
|
||||
((or (eq ':STATIC (car args))
|
||||
(eq ':static (car args)))
|
||||
(setq args (cdr args))
|
||||
((or (eq ':STATIC kind)
|
||||
(eq ':static kind))
|
||||
method-static)
|
||||
;; Primary key
|
||||
(t method-primary)))
|
||||
;; get body, and fix contents of args to be the arguments of the fn.
|
||||
(setq body (cdr args)
|
||||
args (car args))
|
||||
(setq loopa args)
|
||||
;; Create a fixed version of the arguments
|
||||
(while loopa
|
||||
(setq argfix (cons (if (listp (car loopa)) (car (car loopa)) (car loopa))
|
||||
argfix))
|
||||
(setq loopa (cdr loopa)))
|
||||
(t method-primary))))
|
||||
;; make sure there is a generic
|
||||
(eieio-defgeneric
|
||||
method
|
||||
(if (stringp (car body))
|
||||
(car body) (format "Generically created method `%s'." method)))
|
||||
(or (documentation code)
|
||||
(format "Generically created method `%s'." method)))
|
||||
;; create symbol for property to bind to. If the first arg is of
|
||||
;; the form (varname vartype) and `vartype' is a class, then
|
||||
;; that class will be the type symbol. If not, then it will fall
|
||||
;; under the type `primary' which is a non-specific calling of the
|
||||
;; function.
|
||||
(setq firstarg (car args))
|
||||
(if (listp firstarg)
|
||||
(progn
|
||||
(setq argclass (nth 1 firstarg))
|
||||
(if argclass
|
||||
(if (not (class-p argclass))
|
||||
(error "Unknown class type %s in method parameters"
|
||||
(nth 1 firstarg))))
|
||||
argclass))
|
||||
(if (= key -1)
|
||||
(signal 'wrong-type-argument (list :static 'non-class-arg)))
|
||||
;; generics are higher
|
||||
@ -1884,11 +1848,11 @@ OBJECT can be an instance or a class."
|
||||
;; Skip typechecking while retrieving this value.
|
||||
(let ((eieio-skip-typecheck t))
|
||||
;; Return nil if the magic symbol is in there.
|
||||
(if (eieio-object-p object)
|
||||
(if (eq (eieio-oref object slot) eieio-unbound) nil t)
|
||||
(if (class-p object)
|
||||
(if (eq (eieio-oref-default object slot) eieio-unbound) nil t)
|
||||
(signal 'wrong-type-argument (list 'eieio-object-p object))))))
|
||||
(not (eq (cond
|
||||
((eieio-object-p object) (eieio-oref object slot))
|
||||
((class-p object) (eieio-oref-default object slot))
|
||||
(t (signal 'wrong-type-argument (list 'eieio-object-p object))))
|
||||
eieio-unbound))))
|
||||
|
||||
(defun slot-makeunbound (object slot)
|
||||
"In OBJECT, make SLOT unbound."
|
||||
|
||||
@ -64,8 +64,8 @@ Level :debug is ignored by default (see `warning-minimum-level').")
|
||||
(critical . :emergency)
|
||||
(alarm . :emergency))
|
||||
"Alist of aliases for severity levels for `display-warning'.
|
||||
Each element looks like (ALIAS . LEVEL) and defines
|
||||
ALIAS as equivalent to LEVEL. LEVEL must be defined in `warning-levels';
|
||||
Each element looks like (ALIAS . LEVEL) and defines ALIAS as
|
||||
equivalent to LEVEL. LEVEL must be defined in `warning-levels';
|
||||
it may not itself be an alias.")
|
||||
|
||||
(defcustom warning-minimum-level :warning
|
||||
@ -141,7 +141,7 @@ the beginning of the warning.")
|
||||
A marker indicates a position in the warnings buffer
|
||||
which is the start of the current series; it means that
|
||||
additional warnings in the same buffer should not move point.
|
||||
t means the next warning begins a series (and stores a marker here).
|
||||
If t, the next warning begins a series (and stores a marker here).
|
||||
A symbol with a function definition is like t, except
|
||||
also call that function before the next warning.")
|
||||
(put 'warning-series 'risky-local-variable t)
|
||||
@ -235,7 +235,7 @@ See also `warning-series', `warning-prefix-function' and
|
||||
(warning-suppress-p type warning-suppress-log-types)
|
||||
(let* ((typename (if (consp type) (car type) type))
|
||||
(old (get-buffer buffer-name))
|
||||
(buffer (get-buffer-create buffer-name))
|
||||
(buffer (or old (get-buffer-create buffer-name)))
|
||||
(level-info (assq level warning-levels))
|
||||
start end)
|
||||
(with-current-buffer buffer
|
||||
@ -251,60 +251,60 @@ See also `warning-series', `warning-prefix-function' and
|
||||
(unless (eq warning-series t)
|
||||
(funcall warning-series)))))
|
||||
(let ((inhibit-read-only t))
|
||||
(unless (bolp)
|
||||
(newline))
|
||||
(setq start (point))
|
||||
(if warning-prefix-function
|
||||
(setq level-info (funcall warning-prefix-function
|
||||
level level-info)))
|
||||
(insert (format (nth 1 level-info)
|
||||
(format warning-type-format typename))
|
||||
message)
|
||||
(newline)
|
||||
(when (and warning-fill-prefix (not (string-match "\n" message)))
|
||||
(let ((fill-prefix warning-fill-prefix)
|
||||
(fill-column 78))
|
||||
(fill-region start (point))))
|
||||
(setq end (point)))
|
||||
(unless (bolp)
|
||||
(newline))
|
||||
(setq start (point))
|
||||
(if warning-prefix-function
|
||||
(setq level-info (funcall warning-prefix-function
|
||||
level level-info)))
|
||||
(insert (format (nth 1 level-info)
|
||||
(format warning-type-format typename))
|
||||
message)
|
||||
(newline)
|
||||
(when (and warning-fill-prefix (not (string-match "\n" message)))
|
||||
(let ((fill-prefix warning-fill-prefix)
|
||||
(fill-column 78))
|
||||
(fill-region start (point))))
|
||||
(setq end (point)))
|
||||
(when (and (markerp warning-series)
|
||||
(eq (marker-buffer warning-series) buffer))
|
||||
(goto-char warning-series)))
|
||||
(if (nth 2 level-info)
|
||||
(funcall (nth 2 level-info)))
|
||||
(cond (noninteractive
|
||||
;; Noninteractively, take the text we inserted
|
||||
;; in the warnings buffer and print it.
|
||||
;; Do this unconditionally, since there is no way
|
||||
;; to view logged messages unless we output them.
|
||||
(with-current-buffer buffer
|
||||
(save-excursion
|
||||
;; Don't include the final newline in the arg
|
||||
;; to `message', because it adds a newline.
|
||||
(goto-char end)
|
||||
(if (bolp)
|
||||
(forward-char -1))
|
||||
(message "%s" (buffer-substring start (point))))))
|
||||
((and (daemonp) (null after-init-time))
|
||||
;; Warnings assigned during daemon initialization go into
|
||||
;; the messages buffer.
|
||||
(message "%s"
|
||||
(with-current-buffer buffer
|
||||
(save-excursion
|
||||
(goto-char end)
|
||||
(if (bolp)
|
||||
(forward-char -1))
|
||||
(buffer-substring start (point))))))
|
||||
(t
|
||||
;; Interactively, decide whether the warning merits
|
||||
;; immediate display.
|
||||
(or (< (warning-numeric-level level)
|
||||
(warning-numeric-level warning-minimum-level))
|
||||
(warning-suppress-p type warning-suppress-types)
|
||||
(let ((window (display-buffer buffer)))
|
||||
(when (and (markerp warning-series)
|
||||
(eq (marker-buffer warning-series) buffer))
|
||||
(set-window-start window warning-series))
|
||||
(sit-for 0))))))))
|
||||
(cond (noninteractive
|
||||
;; Noninteractively, take the text we inserted
|
||||
;; in the warnings buffer and print it.
|
||||
;; Do this unconditionally, since there is no way
|
||||
;; to view logged messages unless we output them.
|
||||
(with-current-buffer buffer
|
||||
(save-excursion
|
||||
;; Don't include the final newline in the arg
|
||||
;; to `message', because it adds a newline.
|
||||
(goto-char end)
|
||||
(if (bolp)
|
||||
(forward-char -1))
|
||||
(message "%s" (buffer-substring start (point))))))
|
||||
((and (daemonp) (null after-init-time))
|
||||
;; Warnings assigned during daemon initialization go into
|
||||
;; the messages buffer.
|
||||
(message "%s"
|
||||
(with-current-buffer buffer
|
||||
(save-excursion
|
||||
(goto-char end)
|
||||
(if (bolp)
|
||||
(forward-char -1))
|
||||
(buffer-substring start (point))))))
|
||||
(t
|
||||
;; Interactively, decide whether the warning merits
|
||||
;; immediate display.
|
||||
(or (< (warning-numeric-level level)
|
||||
(warning-numeric-level warning-minimum-level))
|
||||
(warning-suppress-p type warning-suppress-types)
|
||||
(let ((window (display-buffer buffer)))
|
||||
(when (and (markerp warning-series)
|
||||
(eq (marker-buffer warning-series) buffer))
|
||||
(set-window-start window warning-series))
|
||||
(sit-for 0))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun lwarn (type level message &rest args)
|
||||
|
||||
@ -1,3 +1,7 @@
|
||||
2011-05-04 Teodor Zlatanov <tzz@lifelogs.com>
|
||||
|
||||
* registry.el (registry-reindex): Fix percentage message.
|
||||
|
||||
2011-05-03 Teodor Zlatanov <tzz@lifelogs.com>
|
||||
|
||||
* shr.el: Add shr-link face for links.
|
||||
|
||||
@ -298,7 +298,7 @@ Errors out if the key exists already."
|
||||
(when (and (< 0 expected)
|
||||
(= 0 (mod count 1000)))
|
||||
(message "reindexing: %d of %d (%.2f%%)"
|
||||
count expected (/ (* 1000 count) expected)))
|
||||
count expected (/ (* 100 count) expected)))
|
||||
(dolist (val (cdr-safe (assq tr v)))
|
||||
(let* ((value-keys (registry-lookup-secondary-value db tr val)))
|
||||
(push key value-keys)
|
||||
|
||||
@ -116,6 +116,15 @@ parenthesis expression starts."
|
||||
:group 'glasses
|
||||
:type '(repeat regexp))
|
||||
|
||||
(defcustom glasses-separate-capital-groups t
|
||||
"If non-nil, try to separate groups of capital letters.
|
||||
When the value is non-nil, HTMLSomething and IPv6 are displayed
|
||||
as HTML_Something and I_Pv6 respectively. Set the value to nil
|
||||
if you prefer to display them unchanged."
|
||||
:group 'glasses
|
||||
:type 'boolean
|
||||
:version "24.1")
|
||||
|
||||
(defcustom glasses-uncapitalize-p nil
|
||||
"If non-nil, downcase embedded capital letters in identifiers.
|
||||
Only identifiers starting with lower case letters are affected, letters inside
|
||||
@ -212,8 +221,11 @@ CATEGORY is the overlay category. If it is nil, use the `glasses' category."
|
||||
'glasses-init))
|
||||
;; Face + separator
|
||||
(goto-char beg)
|
||||
(while (re-search-forward "[a-z]\\([A-Z]\\)\\|[A-Z]\\([A-Z]\\)[a-z]"
|
||||
end t)
|
||||
(while (re-search-forward
|
||||
(if glasses-separate-capital-groups
|
||||
"[a-z]\\([A-Z]\\)\\|[A-Z]\\([A-Z]\\)[a-z]"
|
||||
"[a-z]\\([A-Z]\\)")
|
||||
end t)
|
||||
(let* ((n (if (match-string 1) 1 2))
|
||||
(o (glasses-make-overlay (match-beginning n) (match-end n))))
|
||||
(goto-char (match-beginning n))
|
||||
|
||||
@ -202,13 +202,14 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
|
||||
'(png "libpng12d.dll" "libpng12.dll" "libpng3.dll" "libpng.dll"
|
||||
;; these are libpng 1.2.8 from GTK+
|
||||
"libpng13d.dll" "libpng13.dll"))
|
||||
'(jpeg "jpeg62.dll" "libjpeg.dll" "jpeg-62.dll" "jpeg.dll")
|
||||
'(tiff "libtiff3.dll" "libtiff.dll")
|
||||
'(gif "giflib4.dll" "libungif4.dll" "libungif.dll")
|
||||
'(svg "librsvg-2-2.dll")
|
||||
'(gdk-pixbuf "libgdk_pixbuf-2.0-0.dll")
|
||||
'(glib "libglib-2.0-0.dll")
|
||||
'(gobject "libgobject-2.0-0.dll")))
|
||||
'(jpeg "jpeg62.dll" "libjpeg.dll" "jpeg-62.dll" "jpeg.dll")
|
||||
'(tiff "libtiff3.dll" "libtiff.dll")
|
||||
'(gif "giflib4.dll" "libungif4.dll" "libungif.dll")
|
||||
'(svg "librsvg-2-2.dll")
|
||||
'(gdk-pixbuf "libgdk_pixbuf-2.0-0.dll")
|
||||
'(glib "libglib-2.0-0.dll")
|
||||
'(gobject "libgobject-2.0-0.dll")
|
||||
'(gnutls "libgnutls-26.dll")))
|
||||
|
||||
;;; multi-tty support
|
||||
(defvar w32-initialized nil
|
||||
|
||||
17
nt/ChangeLog
17
nt/ChangeLog
@ -1,9 +1,24 @@
|
||||
2011-04-30 Paul Eggert <eggert@cs.ucla.edu>
|
||||
2011-05-05 Paul Eggert <eggert@cs.ucla.edu>
|
||||
|
||||
* config.nt: Configure 64-bit integers for older compilers.
|
||||
(EMACS_INT, BITS_PER_EMACS_INT, pI): Define these if __int64 and
|
||||
"%I64d" work but long long and "%lld" do not.
|
||||
|
||||
2011-05-05 Ben Key <bkey76@gmail.com>
|
||||
|
||||
* configure.bat: Added support for --cflags and --ldflags
|
||||
options that include quotes as long as command extensions are
|
||||
enabled. Specifically when -I, -L, and similar flags are used
|
||||
to specify supplementary include and library directories a
|
||||
directory name that includes spaces may now be used if it is
|
||||
enclosed in quotes.
|
||||
|
||||
* INSTALL: Documented the change to configure.bat.
|
||||
|
||||
2011-05-04 Juanma Barranquero <lekktu@gmail.com>
|
||||
|
||||
* INSTALL: Clarify GnuTLS support.
|
||||
|
||||
2011-04-30 Eli Zaretskii <eliz@gnu.org>
|
||||
|
||||
* config.nt (HAVE_LONG_LONG_INT, HAVE_UNSIGNED_LONG_LONG_INT):
|
||||
|
||||
29
nt/INSTALL
29
nt/INSTALL
@ -245,6 +245,20 @@
|
||||
be displayed informing you that "using parameters that include the =
|
||||
character by enclosing them in quotes will not be supported."
|
||||
|
||||
You may also use the --cflags and --ldflags options to pass
|
||||
additional parameters to the compiler and linker, respectively; they
|
||||
are frequently used to pass -I and -L flags to specify supplementary
|
||||
include and library directories. If a directory name includes
|
||||
spaces, you will need to enclose it in quotes, as follows
|
||||
-I"C:/Program Files/GnuTLS-2.10.1/include". Note that only the
|
||||
directory name is enclosed in quotes, not the entire argument. Also
|
||||
note that this functionality is only supported if command extensions
|
||||
are available. If command extensions are disabled and you attempt to
|
||||
use this functionality you may see the following warning message
|
||||
"Error in --cflags argument: ... Backslashes and quotes cannot be
|
||||
used with --cflags. Please use forward slashes for filenames and
|
||||
paths (e.g. when passing directories to -I)."
|
||||
|
||||
N.B. It is normal to see a few error messages output while configure
|
||||
is running, when gcc support is being tested. These cannot be
|
||||
suppressed because of limitations in the Windows 9X command.com shell.
|
||||
@ -325,12 +339,17 @@
|
||||
|
||||
* Optional GnuTLS support
|
||||
|
||||
You can build Emacs with GnuTLS support. Put the gnutls/gnutls.h header in
|
||||
the include path and link to the appropriate libraries (gnutls.dll and
|
||||
gcrypt.dll) with the --lib option.
|
||||
If configure.bat finds the gnutls/gnutls.h file in the include path,
|
||||
Emacs is built with GnuTLS support by default; to avoid that you can
|
||||
pass the argument --without-gnutls.
|
||||
|
||||
You can get pre-built binaries and an installer at
|
||||
http://josefsson.org/gnutls4win/.
|
||||
In order to support GnuTLS at runtime, a GnuTLS-enabled Emacs must
|
||||
be able to find the relevant DLLs during startup; failure to do so
|
||||
is not an error, but GnuTLS won't be available to the running
|
||||
session.
|
||||
|
||||
You can get pre-built binaries (including any required DLL and the
|
||||
gnutls.h file) and an installer at http://josefsson.org/gnutls4win/.
|
||||
|
||||
* Experimental SVG support
|
||||
|
||||
|
||||
@ -97,8 +97,10 @@ set profile=N
|
||||
set nocygwin=N
|
||||
set COMPILER=
|
||||
set usercflags=
|
||||
set fusercflags=
|
||||
set docflags=
|
||||
set userldflags=
|
||||
set fuserldflags=
|
||||
set extrauserlibs=
|
||||
set doldflags=
|
||||
set doextralibs=
|
||||
@ -238,6 +240,7 @@ goto ucflagne
|
||||
:ucflagex
|
||||
shift
|
||||
set usercflags=%usercflags%%sep1%%~1
|
||||
set fusercflags=%usercflags:"=\"%
|
||||
set sep1= %nothing%
|
||||
shift
|
||||
goto again
|
||||
@ -245,6 +248,7 @@ goto again
|
||||
:ucflagne
|
||||
shift
|
||||
set usercflags=%usercflags%%sep1%%1
|
||||
set fusercflags=%usercflags%
|
||||
set sep1= %nothing%
|
||||
shift
|
||||
goto again
|
||||
@ -266,6 +270,7 @@ goto ulflagne
|
||||
:ulflagex
|
||||
shift
|
||||
set userldflags=%userldflags%%sep2%%~1
|
||||
set fuserldflags=%userldflags:"=\"%
|
||||
set sep2= %nothing%
|
||||
shift
|
||||
goto again
|
||||
@ -273,6 +278,7 @@ goto again
|
||||
:ulflagne
|
||||
shift
|
||||
set userldflags=%userldflags%%sep2%%1
|
||||
set fuserldflags=%userldflags%
|
||||
set sep2= %nothing%
|
||||
shift
|
||||
goto again
|
||||
@ -437,7 +443,7 @@ goto nocompiler
|
||||
:chkuser
|
||||
rm -f junk.o
|
||||
echo int main (int argc, char *argv[]) {>junk.c
|
||||
echo char *usercflags = "%usercflags%";>>junk.c
|
||||
echo char *usercflags = "%fusercflags%";>>junk.c
|
||||
echo }>>junk.c
|
||||
echo gcc -Werror -c junk.c >>config.log
|
||||
gcc -Werror -c junk.c >>config.log 2>&1
|
||||
@ -745,8 +751,8 @@ echo. >>config.tmp
|
||||
echo /* Start of settings from configure.bat. */ >>config.tmp
|
||||
rem We write USER_CFLAGS and USER_LDFLAGS starting with a space to simplify
|
||||
rem processing of compiler options in w32.c:get_emacs_configuration_options
|
||||
if (%docflags%) == (Y) echo #define USER_CFLAGS " %usercflags%">>config.tmp
|
||||
if (%doldflags%) == (Y) echo #define USER_LDFLAGS " %userldflags%">>config.tmp
|
||||
if (%docflags%) == (Y) echo #define USER_CFLAGS " %fusercflags%">>config.tmp
|
||||
if (%doldflags%) == (Y) echo #define USER_LDFLAGS " %fuserldflags%">>config.tmp
|
||||
if (%profile%) == (Y) echo #define PROFILING 1 >>config.tmp
|
||||
if not "(%HAVE_PNG%)" == "()" echo #define HAVE_PNG 1 >>config.tmp
|
||||
if not "(%HAVE_GNUTLS%)" == "()" echo #define HAVE_GNUTLS 1 >>config.tmp
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
2011-05-04 Paul Eggert <eggert@cs.ucla.edu>
|
||||
2011-05-05 Paul Eggert <eggert@cs.ucla.edu>
|
||||
|
||||
* term.c (vfatal): Remove stray call to va_end.
|
||||
It's not needed and the C Standard doesn't allow it here anyway.
|
||||
@ -119,6 +119,83 @@
|
||||
|
||||
* fns.c (Frandom): Let EMACS_UINT be wider than unsigned long.
|
||||
|
||||
2011-05-05 Eli Zaretskii <eliz@gnu.org>
|
||||
|
||||
* w32heap.c (allocate_heap) [USE_LISP_UNION_TYPE || USE_LSB_TAG]:
|
||||
New version that can reserve upto 2GB of heap space.
|
||||
|
||||
2011-05-05 Chong Yidong <cyd@stupidchicken.com>
|
||||
|
||||
* nsfns.m (Fns_read_file_name): Doc fix (Bug#8534).
|
||||
|
||||
2011-05-05 Teodor Zlatanov <tzz@lifelogs.com>
|
||||
|
||||
* gnutls.c (fn_gnutls_certificate_set_x509_key_file): Add alias to
|
||||
`gnutls_certificate_set_x509_key_file'.
|
||||
|
||||
2011-05-05 Juanma Barranquero <lekktu@gmail.com>
|
||||
|
||||
* makefile.w32-in ($(BLD)/image.$(O), $(BLD)/process.$(O)):
|
||||
Update dependencies.
|
||||
|
||||
2011-05-04 Juanma Barranquero <lekktu@gmail.com>
|
||||
|
||||
* gnutls.h (emacs_gnutls_write, emacs_gnutls_read):
|
||||
* gnutls.c (emacs_gnutls_write, emacs_gnutls_read):
|
||||
Remove unused parameter `fildes'.
|
||||
* process.c (read_process_output, send_process): Don't pass it.
|
||||
|
||||
2011-05-04 Juanma Barranquero <lekktu@gmail.com>
|
||||
|
||||
Fix previous change: the library cache is defined in w32.c.
|
||||
* image.c (CACHE_IMAGE_TYPE) [!HAVE_NTGUI]: Define to noop.
|
||||
(Finit_image_library): Wrap Vlibrary_cache on "#ifdef HAVE_NTGUI".
|
||||
|
||||
2011-05-04 Juanma Barranquero <lekktu@gmail.com>
|
||||
|
||||
Implement dynamic loading of GnuTLS on Windows.
|
||||
|
||||
* gnutls.h (GNUTLS_EMACS_ERROR_NOT_LOADED): New macro.
|
||||
(emacs_gnutls_write, emacs_gnutls_read): Mark as extern.
|
||||
(emacs_gnutls_record_check_pending, emacs_gnutls_transport_set_errno):
|
||||
Declare.
|
||||
|
||||
* gnutls.c (Qgnutls_dll): Define.
|
||||
(DEF_GNUTLS_FN, LOAD_GNUTLS_FN): New macros.
|
||||
(gnutls_*): Declare function pointers.
|
||||
(init_gnutls_functions): New function to initialize function pointers.
|
||||
(emacs_gnutls_handshake, Fgnutls_error_string, Fgnutls_deinit)
|
||||
(emacs_gnutls_global_init, Fgnutls_bye): Use function pointers.
|
||||
(emacs_gnutls_record_check_pending, emacs_gnutls_transport_set_errno):
|
||||
Wrappers for gnutls_record_check_pending and gnutls_transport_set_errno.
|
||||
(emacs_gnutls_write, emacs_gnutls_read)
|
||||
(emacs_gnutls_handle_error, Fgnutls_error_fatalp)
|
||||
(Fgnutls_available_p): New function.
|
||||
(Fgnutls_boot): Call Fgnutls_available_p. Use function pointers.
|
||||
(syms_of_gnutls) <Qgnutls_dll>: Initialize and staticpro it.
|
||||
(syms_of_gnutls) <Sgnutls_available_p>: defsubr it.
|
||||
|
||||
* image.c: Include w32.h.
|
||||
(Vimage_type_cache): Delete.
|
||||
(syms_of_image) <Vimage_type_cache>: Don't initialize and staticpro it.
|
||||
(CACHE_IMAGE_TYPE, Finit_image_library): Use Vlibrary_cache instead.
|
||||
(w32_delayed_load): Move to w32.c.
|
||||
|
||||
* w32.h (VlibraryCache, QCloaded_from, w32_delayed_load): Declare.
|
||||
|
||||
* w32.c (QCloaded_from, Vlibrary_cache): Define.
|
||||
(w32_delayed_load): Move from image.c. When loading a library, record
|
||||
its filename in the :loaded-from property of the library id.
|
||||
(globals_of_w32) <QCloaded_from, Vlibrary_cache>:
|
||||
Initialize and staticpro them.
|
||||
(emacs_gnutls_pull, emacs_gnutls_push): Call emacs_gnutls_* functions.
|
||||
|
||||
* process.c: Include lisp.h before w32.h, not after.
|
||||
(wait_reading_process_output): Call emacs_gnutls_record_check_pending
|
||||
instead of gnutls_record_check_pending.
|
||||
|
||||
* callproc.c, emacs.c: Include lisp.h before w32.h, not after.
|
||||
|
||||
2011-05-04 Teodor Zlatanov <tzz@lifelogs.com>
|
||||
|
||||
* gnutls.c (Fgnutls_boot): Support :keylist and :crlfiles options
|
||||
|
||||
@ -29,6 +29,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
|
||||
#include <sys/file.h>
|
||||
#include <fcntl.h>
|
||||
|
||||
#include "lisp.h"
|
||||
|
||||
#ifdef WINDOWSNT
|
||||
#define NOMINMAX
|
||||
#include <windows.h>
|
||||
@ -41,7 +43,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
|
||||
#include <sys/param.h>
|
||||
#endif /* MSDOS */
|
||||
|
||||
#include "lisp.h"
|
||||
#include "commands.h"
|
||||
#include "buffer.h"
|
||||
#include "character.h"
|
||||
|
||||
@ -29,6 +29,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
|
||||
#include <setjmp.h>
|
||||
#include <unistd.h>
|
||||
|
||||
#include "lisp.h"
|
||||
|
||||
#ifdef WINDOWSNT
|
||||
#include <fcntl.h>
|
||||
#include <windows.h> /* just for w32.h */
|
||||
@ -41,7 +43,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
|
||||
#include <GNUstepBase/GSConfig.h>
|
||||
#endif
|
||||
|
||||
#include "lisp.h"
|
||||
#include "commands.h"
|
||||
#include "intervals.h"
|
||||
#include "buffer.h"
|
||||
|
||||
329
src/gnutls.c
329
src/gnutls.c
@ -34,6 +34,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
|
||||
static int
|
||||
emacs_gnutls_handle_error (gnutls_session_t, int err);
|
||||
|
||||
static Lisp_Object Qgnutls_dll;
|
||||
static Lisp_Object Qgnutls_log_level;
|
||||
static Lisp_Object Qgnutls_code;
|
||||
static Lisp_Object Qgnutls_anon, Qgnutls_x509pki;
|
||||
@ -56,6 +57,182 @@ static Lisp_Object Qgnutls_bootprop_verify_hostname_error;
|
||||
/* Callback keys for `gnutls-boot'. Unused currently. */
|
||||
static Lisp_Object Qgnutls_bootprop_callbacks_verify;
|
||||
|
||||
static void gnutls_log_function (int, const char *);
|
||||
static void gnutls_log_function2 (int, const char*, const char*);
|
||||
|
||||
|
||||
#ifdef WINDOWSNT
|
||||
|
||||
/* Macro for defining functions that will be loaded from the GnuTLS DLL. */
|
||||
#define DEF_GNUTLS_FN(rettype,func,args) rettype (FAR CDECL *fn_##func)args
|
||||
|
||||
/* Macro for loading GnuTLS functions from the library. */
|
||||
#define LOAD_GNUTLS_FN(lib,func) { \
|
||||
fn_##func = (void *) GetProcAddress (lib, #func); \
|
||||
if (!fn_##func) return 0; \
|
||||
}
|
||||
|
||||
DEF_GNUTLS_FN (gnutls_alert_description_t, gnutls_alert_get,
|
||||
(gnutls_session_t));
|
||||
DEF_GNUTLS_FN (const char *, gnutls_alert_get_name,
|
||||
(gnutls_alert_description_t));
|
||||
DEF_GNUTLS_FN (int, gnutls_alert_send_appropriate, (gnutls_session_t, int));
|
||||
DEF_GNUTLS_FN (int, gnutls_anon_allocate_client_credentials,
|
||||
(gnutls_anon_client_credentials_t *));
|
||||
DEF_GNUTLS_FN (void, gnutls_anon_free_client_credentials,
|
||||
(gnutls_anon_client_credentials_t));
|
||||
DEF_GNUTLS_FN (int, gnutls_bye, (gnutls_session_t, gnutls_close_request_t));
|
||||
DEF_GNUTLS_FN (int, gnutls_certificate_allocate_credentials,
|
||||
(gnutls_certificate_credentials_t *));
|
||||
DEF_GNUTLS_FN (void, gnutls_certificate_free_credentials,
|
||||
(gnutls_certificate_credentials_t));
|
||||
DEF_GNUTLS_FN (const gnutls_datum_t *, gnutls_certificate_get_peers,
|
||||
(gnutls_session_t, unsigned int *));
|
||||
DEF_GNUTLS_FN (void, gnutls_certificate_set_verify_flags,
|
||||
(gnutls_certificate_credentials_t, unsigned int));
|
||||
DEF_GNUTLS_FN (int, gnutls_certificate_set_x509_crl_file,
|
||||
(gnutls_certificate_credentials_t, const char *,
|
||||
gnutls_x509_crt_fmt_t));
|
||||
DEF_GNUTLS_FN (int, gnutls_certificate_set_x509_key_file,
|
||||
(gnutls_certificate_credentials_t, const char *, const char *,
|
||||
gnutls_x509_crt_fmt_t));
|
||||
DEF_GNUTLS_FN (int, gnutls_certificate_set_x509_trust_file,
|
||||
(gnutls_certificate_credentials_t, const char *,
|
||||
gnutls_x509_crt_fmt_t));
|
||||
DEF_GNUTLS_FN (gnutls_certificate_type_t, gnutls_certificate_type_get,
|
||||
(gnutls_session_t));
|
||||
DEF_GNUTLS_FN (int, gnutls_certificate_verify_peers2,
|
||||
(gnutls_session_t, unsigned int *));
|
||||
DEF_GNUTLS_FN (int, gnutls_credentials_set,
|
||||
(gnutls_session_t, gnutls_credentials_type_t, void *));
|
||||
DEF_GNUTLS_FN (void, gnutls_deinit, (gnutls_session_t));
|
||||
DEF_GNUTLS_FN (int, gnutls_error_is_fatal, (int));
|
||||
DEF_GNUTLS_FN (int, gnutls_global_init, (void));
|
||||
DEF_GNUTLS_FN (void, gnutls_global_set_log_function, (gnutls_log_func));
|
||||
DEF_GNUTLS_FN (void, gnutls_global_set_log_level, (int));
|
||||
DEF_GNUTLS_FN (int, gnutls_handshake, (gnutls_session_t));
|
||||
DEF_GNUTLS_FN (int, gnutls_init, (gnutls_session_t *, gnutls_connection_end_t));
|
||||
DEF_GNUTLS_FN (int, gnutls_priority_set_direct,
|
||||
(gnutls_session_t, const char *, const char **));
|
||||
DEF_GNUTLS_FN (size_t, gnutls_record_check_pending, (gnutls_session_t));
|
||||
DEF_GNUTLS_FN (ssize_t, gnutls_record_recv, (gnutls_session_t, void *, size_t));
|
||||
DEF_GNUTLS_FN (ssize_t, gnutls_record_send,
|
||||
(gnutls_session_t, const void *, size_t));
|
||||
DEF_GNUTLS_FN (const char *, gnutls_strerror, (int));
|
||||
DEF_GNUTLS_FN (void, gnutls_transport_set_errno, (gnutls_session_t, int));
|
||||
DEF_GNUTLS_FN (void, gnutls_transport_set_lowat, (gnutls_session_t, int));
|
||||
DEF_GNUTLS_FN (void, gnutls_transport_set_ptr2,
|
||||
(gnutls_session_t, gnutls_transport_ptr_t,
|
||||
gnutls_transport_ptr_t));
|
||||
DEF_GNUTLS_FN (void, gnutls_transport_set_pull_function,
|
||||
(gnutls_session_t, gnutls_pull_func));
|
||||
DEF_GNUTLS_FN (void, gnutls_transport_set_push_function,
|
||||
(gnutls_session_t, gnutls_push_func));
|
||||
DEF_GNUTLS_FN (int, gnutls_x509_crt_check_hostname,
|
||||
(gnutls_x509_crt_t, const char *));
|
||||
DEF_GNUTLS_FN (void, gnutls_x509_crt_deinit, (gnutls_x509_crt_t));
|
||||
DEF_GNUTLS_FN (int, gnutls_x509_crt_import,
|
||||
(gnutls_x509_crt_t, const gnutls_datum_t *,
|
||||
gnutls_x509_crt_fmt_t));
|
||||
DEF_GNUTLS_FN (int, gnutls_x509_crt_init, (gnutls_x509_crt_t *));
|
||||
|
||||
static int
|
||||
init_gnutls_functions (Lisp_Object libraries)
|
||||
{
|
||||
HMODULE library;
|
||||
|
||||
if (!(library = w32_delayed_load (libraries, Qgnutls_dll)))
|
||||
{
|
||||
GNUTLS_LOG (1, 1, "GnuTLS library not found");
|
||||
return 0;
|
||||
}
|
||||
|
||||
LOAD_GNUTLS_FN (library, gnutls_alert_get);
|
||||
LOAD_GNUTLS_FN (library, gnutls_alert_get_name);
|
||||
LOAD_GNUTLS_FN (library, gnutls_alert_send_appropriate);
|
||||
LOAD_GNUTLS_FN (library, gnutls_anon_allocate_client_credentials);
|
||||
LOAD_GNUTLS_FN (library, gnutls_anon_free_client_credentials);
|
||||
LOAD_GNUTLS_FN (library, gnutls_bye);
|
||||
LOAD_GNUTLS_FN (library, gnutls_certificate_allocate_credentials);
|
||||
LOAD_GNUTLS_FN (library, gnutls_certificate_free_credentials);
|
||||
LOAD_GNUTLS_FN (library, gnutls_certificate_get_peers);
|
||||
LOAD_GNUTLS_FN (library, gnutls_certificate_set_verify_flags);
|
||||
LOAD_GNUTLS_FN (library, gnutls_certificate_set_x509_crl_file);
|
||||
LOAD_GNUTLS_FN (library, gnutls_certificate_set_x509_key_file);
|
||||
LOAD_GNUTLS_FN (library, gnutls_certificate_set_x509_trust_file);
|
||||
LOAD_GNUTLS_FN (library, gnutls_certificate_type_get);
|
||||
LOAD_GNUTLS_FN (library, gnutls_certificate_verify_peers2);
|
||||
LOAD_GNUTLS_FN (library, gnutls_credentials_set);
|
||||
LOAD_GNUTLS_FN (library, gnutls_deinit);
|
||||
LOAD_GNUTLS_FN (library, gnutls_error_is_fatal);
|
||||
LOAD_GNUTLS_FN (library, gnutls_global_init);
|
||||
LOAD_GNUTLS_FN (library, gnutls_global_set_log_function);
|
||||
LOAD_GNUTLS_FN (library, gnutls_global_set_log_level);
|
||||
LOAD_GNUTLS_FN (library, gnutls_handshake);
|
||||
LOAD_GNUTLS_FN (library, gnutls_init);
|
||||
LOAD_GNUTLS_FN (library, gnutls_priority_set_direct);
|
||||
LOAD_GNUTLS_FN (library, gnutls_record_check_pending);
|
||||
LOAD_GNUTLS_FN (library, gnutls_record_recv);
|
||||
LOAD_GNUTLS_FN (library, gnutls_record_send);
|
||||
LOAD_GNUTLS_FN (library, gnutls_strerror);
|
||||
LOAD_GNUTLS_FN (library, gnutls_transport_set_errno);
|
||||
LOAD_GNUTLS_FN (library, gnutls_transport_set_lowat);
|
||||
LOAD_GNUTLS_FN (library, gnutls_transport_set_ptr2);
|
||||
LOAD_GNUTLS_FN (library, gnutls_transport_set_pull_function);
|
||||
LOAD_GNUTLS_FN (library, gnutls_transport_set_push_function);
|
||||
LOAD_GNUTLS_FN (library, gnutls_x509_crt_check_hostname);
|
||||
LOAD_GNUTLS_FN (library, gnutls_x509_crt_deinit);
|
||||
LOAD_GNUTLS_FN (library, gnutls_x509_crt_import);
|
||||
LOAD_GNUTLS_FN (library, gnutls_x509_crt_init);
|
||||
|
||||
GNUTLS_LOG2 (1, 1, "GnuTLS library loaded:",
|
||||
SDATA (Fget (Qgnutls_dll, QCloaded_from)));
|
||||
return 1;
|
||||
}
|
||||
|
||||
#else /* !WINDOWSNT */
|
||||
|
||||
#define fn_gnutls_alert_get gnutls_alert_get
|
||||
#define fn_gnutls_alert_get_name gnutls_alert_get_name
|
||||
#define fn_gnutls_alert_send_appropriate gnutls_alert_send_appropriate
|
||||
#define fn_gnutls_anon_allocate_client_credentials gnutls_anon_allocate_client_credentials
|
||||
#define fn_gnutls_anon_free_client_credentials gnutls_anon_free_client_credentials
|
||||
#define fn_gnutls_bye gnutls_bye
|
||||
#define fn_gnutls_certificate_allocate_credentials gnutls_certificate_allocate_credentials
|
||||
#define fn_gnutls_certificate_free_credentials gnutls_certificate_free_credentials
|
||||
#define fn_gnutls_certificate_get_peers gnutls_certificate_get_peers
|
||||
#define fn_gnutls_certificate_set_verify_flags gnutls_certificate_set_verify_flags
|
||||
#define fn_gnutls_certificate_set_x509_crl_file gnutls_certificate_set_x509_crl_file
|
||||
#define fn_gnutls_certificate_set_x509_key_file gnutls_certificate_set_x509_key_file
|
||||
#define fn_gnutls_certificate_set_x509_trust_file gnutls_certificate_set_x509_trust_file
|
||||
#define fn_gnutls_certificate_type_get gnutls_certificate_type_get
|
||||
#define fn_gnutls_certificate_verify_peers2 gnutls_certificate_verify_peers2
|
||||
#define fn_gnutls_credentials_set gnutls_credentials_set
|
||||
#define fn_gnutls_deinit gnutls_deinit
|
||||
#define fn_gnutls_error_is_fatal gnutls_error_is_fatal
|
||||
#define fn_gnutls_global_init gnutls_global_init
|
||||
#define fn_gnutls_global_set_log_function gnutls_global_set_log_function
|
||||
#define fn_gnutls_global_set_log_level gnutls_global_set_log_level
|
||||
#define fn_gnutls_handshake gnutls_handshake
|
||||
#define fn_gnutls_init gnutls_init
|
||||
#define fn_gnutls_priority_set_direct gnutls_priority_set_direct
|
||||
#define fn_gnutls_record_check_pending gnutls_record_check_pending
|
||||
#define fn_gnutls_record_recv gnutls_record_recv
|
||||
#define fn_gnutls_record_send gnutls_record_send
|
||||
#define fn_gnutls_strerror gnutls_strerror
|
||||
#define fn_gnutls_transport_set_errno gnutls_transport_set_errno
|
||||
#define fn_gnutls_transport_set_lowat gnutls_transport_set_lowat
|
||||
#define fn_gnutls_transport_set_ptr2 gnutls_transport_set_ptr2
|
||||
#define fn_gnutls_transport_set_pull_function gnutls_transport_set_pull_function
|
||||
#define fn_gnutls_transport_set_push_function gnutls_transport_set_push_function
|
||||
#define fn_gnutls_x509_crt_check_hostname gnutls_x509_crt_check_hostname
|
||||
#define fn_gnutls_x509_crt_deinit gnutls_x509_crt_deinit
|
||||
#define fn_gnutls_x509_crt_import gnutls_x509_crt_import
|
||||
#define fn_gnutls_x509_crt_init gnutls_x509_crt_init
|
||||
|
||||
#endif /* !WINDOWSNT */
|
||||
|
||||
|
||||
static void
|
||||
gnutls_log_function (int level, const char* string)
|
||||
{
|
||||
@ -83,11 +260,11 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
|
||||
/* On W32 we cannot transfer socket handles between different runtime
|
||||
libraries, so we tell GnuTLS to use our special push/pull
|
||||
functions. */
|
||||
gnutls_transport_set_ptr2 (state,
|
||||
(gnutls_transport_ptr_t) proc,
|
||||
(gnutls_transport_ptr_t) proc);
|
||||
gnutls_transport_set_push_function (state, &emacs_gnutls_push);
|
||||
gnutls_transport_set_pull_function (state, &emacs_gnutls_pull);
|
||||
fn_gnutls_transport_set_ptr2 (state,
|
||||
(gnutls_transport_ptr_t) proc,
|
||||
(gnutls_transport_ptr_t) proc);
|
||||
fn_gnutls_transport_set_push_function (state, &emacs_gnutls_push);
|
||||
fn_gnutls_transport_set_pull_function (state, &emacs_gnutls_pull);
|
||||
|
||||
/* For non blocking sockets or other custom made pull/push
|
||||
functions the gnutls_transport_set_lowat must be called, with
|
||||
@ -96,14 +273,14 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
|
||||
(Note: this is probably not strictly necessary as the lowat
|
||||
value is only used when no custom pull/push functions are
|
||||
set.) */
|
||||
gnutls_transport_set_lowat (state, 0);
|
||||
fn_gnutls_transport_set_lowat (state, 0);
|
||||
#else
|
||||
/* This is how GnuTLS takes sockets: as file descriptors passed
|
||||
in. For an Emacs process socket, infd and outfd are the
|
||||
same but we use this two-argument version for clarity. */
|
||||
gnutls_transport_set_ptr2 (state,
|
||||
(gnutls_transport_ptr_t) (long) proc->infd,
|
||||
(gnutls_transport_ptr_t) (long) proc->outfd);
|
||||
fn_gnutls_transport_set_ptr2 (state,
|
||||
(gnutls_transport_ptr_t) (long) proc->infd,
|
||||
(gnutls_transport_ptr_t) (long) proc->outfd);
|
||||
#endif
|
||||
|
||||
proc->gnutls_initstage = GNUTLS_STAGE_TRANSPORT_POINTERS_SET;
|
||||
@ -111,10 +288,10 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
|
||||
|
||||
do
|
||||
{
|
||||
ret = gnutls_handshake (state);
|
||||
ret = fn_gnutls_handshake (state);
|
||||
emacs_gnutls_handle_error (state, ret);
|
||||
}
|
||||
while (ret < 0 && gnutls_error_is_fatal (ret) == 0);
|
||||
while (ret < 0 && fn_gnutls_error_is_fatal (ret) == 0);
|
||||
|
||||
proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED;
|
||||
|
||||
@ -125,14 +302,25 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
|
||||
}
|
||||
else
|
||||
{
|
||||
gnutls_alert_send_appropriate (state, ret);
|
||||
fn_gnutls_alert_send_appropriate (state, ret);
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
int
|
||||
emacs_gnutls_record_check_pending (gnutls_session_t state)
|
||||
{
|
||||
return fn_gnutls_record_check_pending (state);
|
||||
}
|
||||
|
||||
void
|
||||
emacs_gnutls_transport_set_errno (gnutls_session_t state, int err)
|
||||
{
|
||||
fn_gnutls_transport_set_errno (state, err);
|
||||
}
|
||||
|
||||
EMACS_INT
|
||||
emacs_gnutls_write (int fildes, struct Lisp_Process *proc, const char *buf,
|
||||
EMACS_INT nbyte)
|
||||
emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, EMACS_INT nbyte)
|
||||
{
|
||||
ssize_t rtnval = 0;
|
||||
EMACS_INT bytes_written;
|
||||
@ -152,7 +340,7 @@ emacs_gnutls_write (int fildes, struct Lisp_Process *proc, const char *buf,
|
||||
|
||||
while (nbyte > 0)
|
||||
{
|
||||
rtnval = gnutls_write (state, buf, nbyte);
|
||||
rtnval = fn_gnutls_record_send (state, buf, nbyte);
|
||||
|
||||
if (rtnval < 0)
|
||||
{
|
||||
@ -172,8 +360,7 @@ emacs_gnutls_write (int fildes, struct Lisp_Process *proc, const char *buf,
|
||||
}
|
||||
|
||||
EMACS_INT
|
||||
emacs_gnutls_read (int fildes, struct Lisp_Process *proc, char *buf,
|
||||
EMACS_INT nbyte)
|
||||
emacs_gnutls_read (struct Lisp_Process *proc, char *buf, EMACS_INT nbyte)
|
||||
{
|
||||
ssize_t rtnval;
|
||||
gnutls_session_t state = proc->gnutls_state;
|
||||
@ -183,7 +370,7 @@ emacs_gnutls_read (int fildes, struct Lisp_Process *proc, char *buf,
|
||||
emacs_gnutls_handshake (proc);
|
||||
return -1;
|
||||
}
|
||||
rtnval = gnutls_read (state, buf, nbyte);
|
||||
rtnval = fn_gnutls_record_recv (state, buf, nbyte);
|
||||
if (rtnval >= 0)
|
||||
return rtnval;
|
||||
else if (emacs_gnutls_handle_error (state, rtnval) == 0)
|
||||
@ -215,11 +402,11 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err)
|
||||
|
||||
/* TODO: use gnutls-error-fatalp and gnutls-error-string. */
|
||||
|
||||
str = gnutls_strerror (err);
|
||||
str = fn_gnutls_strerror (err);
|
||||
if (!str)
|
||||
str = "unknown";
|
||||
|
||||
if (gnutls_error_is_fatal (err))
|
||||
if (fn_gnutls_error_is_fatal (err))
|
||||
{
|
||||
ret = err;
|
||||
GNUTLS_LOG2 (0, max_log_level, "fatal error:", str);
|
||||
@ -234,9 +421,9 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err)
|
||||
if (err == GNUTLS_E_WARNING_ALERT_RECEIVED
|
||||
|| err == GNUTLS_E_FATAL_ALERT_RECEIVED)
|
||||
{
|
||||
int alert = gnutls_alert_get (session);
|
||||
int alert = fn_gnutls_alert_get (session);
|
||||
int level = (err == GNUTLS_E_FATAL_ALERT_RECEIVED) ? 0 : 1;
|
||||
str = gnutls_alert_get_name (alert);
|
||||
str = fn_gnutls_alert_get_name (alert);
|
||||
if (!str)
|
||||
str = "unknown";
|
||||
|
||||
@ -314,7 +501,7 @@ usage: (gnutls-error-fatalp ERROR) */)
|
||||
if (!NUMBERP (err))
|
||||
error ("Not an error symbol or code");
|
||||
|
||||
if (0 == gnutls_error_is_fatal (XINT (err)))
|
||||
if (0 == fn_gnutls_error_is_fatal (XINT (err)))
|
||||
return Qnil;
|
||||
|
||||
return Qt;
|
||||
@ -346,7 +533,7 @@ usage: (gnutls-error-string ERROR) */)
|
||||
if (!NUMBERP (err))
|
||||
return build_string ("Not an error symbol or code");
|
||||
|
||||
return build_string (gnutls_strerror (XINT (err)));
|
||||
return build_string (fn_gnutls_strerror (XINT (err)));
|
||||
}
|
||||
|
||||
DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0,
|
||||
@ -361,13 +548,34 @@ See also `gnutls-init'. */)
|
||||
|
||||
if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)
|
||||
{
|
||||
gnutls_deinit (state);
|
||||
fn_gnutls_deinit (state);
|
||||
GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1;
|
||||
}
|
||||
|
||||
return Qt;
|
||||
}
|
||||
|
||||
DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0,
|
||||
doc: /* Return t if GnuTLS is available in this instance of Emacs. */)
|
||||
(void)
|
||||
{
|
||||
#ifdef WINDOWSNT
|
||||
Lisp_Object found = Fassq (Qgnutls_dll, Vlibrary_cache);
|
||||
if (CONSP (found))
|
||||
return XCDR (found);
|
||||
else
|
||||
{
|
||||
Lisp_Object status;
|
||||
status = init_gnutls_functions (Vdynamic_library_alist) ? Qt : Qnil;
|
||||
Vlibrary_cache = Fcons (Fcons (Qgnutls_dll, status), Vlibrary_cache);
|
||||
return status;
|
||||
}
|
||||
#else
|
||||
return Qt;
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
/* Initializes global GnuTLS state to defaults.
|
||||
Call `gnutls-global-deinit' when GnuTLS usage is no longer needed.
|
||||
Returns zero on success. */
|
||||
@ -377,8 +585,7 @@ emacs_gnutls_global_init (void)
|
||||
int ret = GNUTLS_E_SUCCESS;
|
||||
|
||||
if (!gnutls_global_initialized)
|
||||
ret = gnutls_global_init ();
|
||||
|
||||
ret = fn_gnutls_global_init ();
|
||||
gnutls_global_initialized = 1;
|
||||
|
||||
return gnutls_make_error (ret);
|
||||
@ -488,6 +695,12 @@ one trustfile (usually a CA bundle). */)
|
||||
CHECK_SYMBOL (type);
|
||||
CHECK_LIST (proplist);
|
||||
|
||||
if (NILP (Fgnutls_available_p ()))
|
||||
{
|
||||
error ("GnuTLS not available");
|
||||
return gnutls_make_error (GNUTLS_EMACS_ERROR_NOT_LOADED);
|
||||
}
|
||||
|
||||
hostname = Fplist_get (proplist, Qgnutls_bootprop_hostname);
|
||||
priority_string = Fplist_get (proplist, Qgnutls_bootprop_priority);
|
||||
trustfiles = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
|
||||
@ -509,8 +722,8 @@ one trustfile (usually a CA bundle). */)
|
||||
|
||||
if (NUMBERP (loglevel))
|
||||
{
|
||||
gnutls_global_set_log_function (gnutls_log_function);
|
||||
gnutls_global_set_log_level (XINT (loglevel));
|
||||
fn_gnutls_global_set_log_function (gnutls_log_function);
|
||||
fn_gnutls_global_set_log_level (XINT (loglevel));
|
||||
max_log_level = XINT (loglevel);
|
||||
XPROCESS (proc)->gnutls_log_level = max_log_level;
|
||||
}
|
||||
@ -529,13 +742,13 @@ one trustfile (usually a CA bundle). */)
|
||||
{
|
||||
GNUTLS_LOG (2, max_log_level, "deallocating x509 credentials");
|
||||
x509_cred = XPROCESS (proc)->gnutls_x509_cred;
|
||||
gnutls_certificate_free_credentials (x509_cred);
|
||||
fn_gnutls_certificate_free_credentials (x509_cred);
|
||||
}
|
||||
else if (EQ (type, Qgnutls_anon))
|
||||
{
|
||||
GNUTLS_LOG (2, max_log_level, "deallocating anon credentials");
|
||||
anon_cred = XPROCESS (proc)->gnutls_anon_cred;
|
||||
gnutls_anon_free_client_credentials (anon_cred);
|
||||
fn_gnutls_anon_free_client_credentials (anon_cred);
|
||||
}
|
||||
else
|
||||
{
|
||||
@ -558,7 +771,7 @@ one trustfile (usually a CA bundle). */)
|
||||
{
|
||||
GNUTLS_LOG (2, max_log_level, "allocating x509 credentials");
|
||||
x509_cred = XPROCESS (proc)->gnutls_x509_cred;
|
||||
if (gnutls_certificate_allocate_credentials (&x509_cred) < 0)
|
||||
if (fn_gnutls_certificate_allocate_credentials (&x509_cred) < 0)
|
||||
memory_full ();
|
||||
|
||||
if (NUMBERP (verify_flags))
|
||||
@ -576,13 +789,13 @@ one trustfile (usually a CA bundle). */)
|
||||
/* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT. */
|
||||
GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
|
||||
}
|
||||
gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
|
||||
fn_gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
|
||||
}
|
||||
else if (EQ (type, Qgnutls_anon))
|
||||
{
|
||||
GNUTLS_LOG (2, max_log_level, "allocating anon credentials");
|
||||
anon_cred = XPROCESS (proc)->gnutls_anon_cred;
|
||||
if (gnutls_anon_allocate_client_credentials (&anon_cred) < 0)
|
||||
if (fn_gnutls_anon_allocate_client_credentials (&anon_cred) < 0)
|
||||
memory_full ();
|
||||
}
|
||||
else
|
||||
@ -605,7 +818,7 @@ one trustfile (usually a CA bundle). */)
|
||||
{
|
||||
GNUTLS_LOG2 (1, max_log_level, "setting the trustfile: ",
|
||||
SSDATA (trustfile));
|
||||
ret = gnutls_certificate_set_x509_trust_file
|
||||
ret = fn_gnutls_certificate_set_x509_trust_file
|
||||
(x509_cred,
|
||||
SSDATA (trustfile),
|
||||
file_format);
|
||||
@ -627,7 +840,7 @@ one trustfile (usually a CA bundle). */)
|
||||
{
|
||||
GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ",
|
||||
SSDATA (crlfile));
|
||||
ret = gnutls_certificate_set_x509_crl_file
|
||||
ret = fn_gnutls_certificate_set_x509_crl_file
|
||||
(x509_cred,
|
||||
SSDATA (crlfile),
|
||||
file_format);
|
||||
@ -652,7 +865,7 @@ one trustfile (usually a CA bundle). */)
|
||||
SSDATA (keyfile));
|
||||
GNUTLS_LOG2 (1, max_log_level, "setting the client cert file: ",
|
||||
SSDATA (certfile));
|
||||
ret = gnutls_certificate_set_x509_key_file
|
||||
ret = fn_gnutls_certificate_set_x509_key_file
|
||||
(x509_cred,
|
||||
SSDATA (certfile),
|
||||
SSDATA (keyfile),
|
||||
@ -685,7 +898,7 @@ one trustfile (usually a CA bundle). */)
|
||||
|
||||
GNUTLS_LOG (1, max_log_level, "gnutls_init");
|
||||
|
||||
ret = gnutls_init (&state, GNUTLS_CLIENT);
|
||||
ret = fn_gnutls_init (&state, GNUTLS_CLIENT);
|
||||
|
||||
if (ret < GNUTLS_E_SUCCESS)
|
||||
return gnutls_make_error (ret);
|
||||
@ -708,9 +921,9 @@ one trustfile (usually a CA bundle). */)
|
||||
|
||||
GNUTLS_LOG (1, max_log_level, "setting the priority string");
|
||||
|
||||
ret = gnutls_priority_set_direct (state,
|
||||
priority_string_ptr,
|
||||
NULL);
|
||||
ret = fn_gnutls_priority_set_direct (state,
|
||||
priority_string_ptr,
|
||||
NULL);
|
||||
|
||||
if (ret < GNUTLS_E_SUCCESS)
|
||||
return gnutls_make_error (ret);
|
||||
@ -719,11 +932,11 @@ one trustfile (usually a CA bundle). */)
|
||||
|
||||
if (EQ (type, Qgnutls_x509pki))
|
||||
{
|
||||
ret = gnutls_cred_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred);
|
||||
ret = fn_gnutls_credentials_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred);
|
||||
}
|
||||
else if (EQ (type, Qgnutls_anon))
|
||||
{
|
||||
ret = gnutls_cred_set (state, GNUTLS_CRD_ANON, anon_cred);
|
||||
ret = fn_gnutls_credentials_set (state, GNUTLS_CRD_ANON, anon_cred);
|
||||
}
|
||||
else
|
||||
{
|
||||
@ -751,7 +964,7 @@ one trustfile (usually a CA bundle). */)
|
||||
check of the certificate's hostname with
|
||||
gnutls_x509_crt_check_hostname() against :hostname. */
|
||||
|
||||
ret = gnutls_certificate_verify_peers2 (state, &peer_verification);
|
||||
ret = fn_gnutls_certificate_verify_peers2 (state, &peer_verification);
|
||||
|
||||
if (ret < GNUTLS_E_SUCCESS)
|
||||
return gnutls_make_error (ret);
|
||||
@ -802,15 +1015,15 @@ one trustfile (usually a CA bundle). */)
|
||||
/* Up to here the process is the same for X.509 certificates and
|
||||
OpenPGP keys. From now on X.509 certificates are assumed. This
|
||||
can be easily extended to work with openpgp keys as well. */
|
||||
if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
|
||||
if (fn_gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
|
||||
{
|
||||
ret = gnutls_x509_crt_init (&gnutls_verify_cert);
|
||||
ret = fn_gnutls_x509_crt_init (&gnutls_verify_cert);
|
||||
|
||||
if (ret < GNUTLS_E_SUCCESS)
|
||||
return gnutls_make_error (ret);
|
||||
|
||||
gnutls_verify_cert_list =
|
||||
gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
|
||||
fn_gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
|
||||
|
||||
if (NULL == gnutls_verify_cert_list)
|
||||
{
|
||||
@ -818,17 +1031,17 @@ one trustfile (usually a CA bundle). */)
|
||||
}
|
||||
|
||||
/* We only check the first certificate in the given chain. */
|
||||
ret = gnutls_x509_crt_import (gnutls_verify_cert,
|
||||
&gnutls_verify_cert_list[0],
|
||||
GNUTLS_X509_FMT_DER);
|
||||
ret = fn_gnutls_x509_crt_import (gnutls_verify_cert,
|
||||
&gnutls_verify_cert_list[0],
|
||||
GNUTLS_X509_FMT_DER);
|
||||
|
||||
if (ret < GNUTLS_E_SUCCESS)
|
||||
{
|
||||
gnutls_x509_crt_deinit (gnutls_verify_cert);
|
||||
fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
|
||||
return gnutls_make_error (ret);
|
||||
}
|
||||
|
||||
if (!gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname))
|
||||
if (!fn_gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname))
|
||||
{
|
||||
if (NILP (verify_hostname_error))
|
||||
{
|
||||
@ -837,13 +1050,13 @@ one trustfile (usually a CA bundle). */)
|
||||
}
|
||||
else
|
||||
{
|
||||
gnutls_x509_crt_deinit (gnutls_verify_cert);
|
||||
fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
|
||||
error ("The x509 certificate does not match \"%s\"",
|
||||
c_hostname);
|
||||
}
|
||||
}
|
||||
|
||||
gnutls_x509_crt_deinit (gnutls_verify_cert);
|
||||
fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
|
||||
}
|
||||
|
||||
return gnutls_make_error (ret);
|
||||
@ -872,8 +1085,8 @@ This function may also return `gnutls-e-again', or
|
||||
|
||||
state = XPROCESS (proc)->gnutls_state;
|
||||
|
||||
ret = gnutls_bye (state,
|
||||
NILP (cont) ? GNUTLS_SHUT_RDWR : GNUTLS_SHUT_WR);
|
||||
ret = fn_gnutls_bye (state,
|
||||
NILP (cont) ? GNUTLS_SHUT_RDWR : GNUTLS_SHUT_WR);
|
||||
|
||||
return gnutls_make_error (ret);
|
||||
}
|
||||
@ -883,6 +1096,9 @@ syms_of_gnutls (void)
|
||||
{
|
||||
gnutls_global_initialized = 0;
|
||||
|
||||
Qgnutls_dll = intern_c_string ("gnutls");
|
||||
staticpro (&Qgnutls_dll);
|
||||
|
||||
Qgnutls_log_level = intern_c_string ("gnutls-log-level");
|
||||
staticpro (&Qgnutls_log_level);
|
||||
|
||||
@ -956,6 +1172,7 @@ syms_of_gnutls (void)
|
||||
defsubr (&Sgnutls_boot);
|
||||
defsubr (&Sgnutls_deinit);
|
||||
defsubr (&Sgnutls_bye);
|
||||
defsubr (&Sgnutls_available_p);
|
||||
}
|
||||
|
||||
#endif /* HAVE_GNUTLS */
|
||||
|
||||
14
src/gnutls.h
14
src/gnutls.h
@ -42,6 +42,7 @@ typedef enum
|
||||
GNUTLS_STAGE_READY,
|
||||
} gnutls_initstage_t;
|
||||
|
||||
#define GNUTLS_EMACS_ERROR_NOT_LOADED GNUTLS_E_APPLICATION_ERROR_MIN + 1
|
||||
#define GNUTLS_EMACS_ERROR_INVALID_TYPE GNUTLS_E_APPLICATION_ERROR_MIN
|
||||
|
||||
#define GNUTLS_INITSTAGE(proc) (XPROCESS (proc)->gnutls_initstage)
|
||||
@ -52,12 +53,13 @@ typedef enum
|
||||
|
||||
#define GNUTLS_LOG2(level, max, string, extra) if (level <= max) { gnutls_log_function2 (level, "(Emacs) " string, extra); }
|
||||
|
||||
EMACS_INT
|
||||
emacs_gnutls_write (int fildes, struct Lisp_Process *proc, const char *buf,
|
||||
EMACS_INT nbyte);
|
||||
EMACS_INT
|
||||
emacs_gnutls_read (int fildes, struct Lisp_Process *proc, char *buf,
|
||||
EMACS_INT nbyte);
|
||||
extern EMACS_INT
|
||||
emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, EMACS_INT nbyte);
|
||||
extern EMACS_INT
|
||||
emacs_gnutls_read (struct Lisp_Process *proc, char *buf, EMACS_INT nbyte);
|
||||
|
||||
extern int emacs_gnutls_record_check_pending (gnutls_session_t state);
|
||||
extern void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err);
|
||||
|
||||
extern void syms_of_gnutls (void);
|
||||
|
||||
|
||||
48
src/image.c
48
src/image.c
@ -67,6 +67,7 @@ typedef struct x_bitmap_record Bitmap_Record;
|
||||
|
||||
|
||||
#ifdef HAVE_NTGUI
|
||||
#include "w32.h"
|
||||
#include "w32term.h"
|
||||
|
||||
/* W32_TODO : Color tables on W32. */
|
||||
@ -556,10 +557,6 @@ x_create_bitmap_mask (struct frame *f, int id)
|
||||
|
||||
static struct image_type *image_types;
|
||||
|
||||
/* Cache for delayed-loading image types. */
|
||||
|
||||
static Lisp_Object Vimage_type_cache;
|
||||
|
||||
/* The symbol `xbm' which is used as the type symbol for XBM images. */
|
||||
|
||||
static Lisp_Object Qxbm;
|
||||
@ -587,9 +584,12 @@ static void x_laplace (struct frame *, struct image *);
|
||||
static void x_emboss (struct frame *, struct image *);
|
||||
static int x_build_heuristic_mask (struct frame *, struct image *,
|
||||
Lisp_Object);
|
||||
|
||||
#ifdef HAVE_NTGUI
|
||||
#define CACHE_IMAGE_TYPE(type, status) \
|
||||
do { Vimage_type_cache = Fcons (Fcons (type, status), Vimage_type_cache); } while (0)
|
||||
do { Vlibrary_cache = Fcons (Fcons (type, status), Vlibrary_cache); } while (0)
|
||||
#else
|
||||
#define CACHE_IMAGE_TYPE(type, status)
|
||||
#endif
|
||||
|
||||
#define ADD_IMAGE_TYPE(type) \
|
||||
do { Vimage_types = Fcons (type, Vimage_types); } while (0)
|
||||
@ -1900,34 +1900,6 @@ mark_image_cache (struct image_cache *c)
|
||||
if (!fn_##func) return 0; \
|
||||
}
|
||||
|
||||
/* Load a DLL implementing an image type.
|
||||
The argument LIBRARIES is usually the variable
|
||||
`dynamic-library-alist', which associates a symbol, identifying
|
||||
an external DLL library, to a list of possible filenames.
|
||||
The function returns NULL if no library could be loaded for
|
||||
the given symbol, or if the library was previously loaded;
|
||||
else the handle of the DLL. */
|
||||
static HMODULE
|
||||
w32_delayed_load (Lisp_Object libraries, Lisp_Object type)
|
||||
{
|
||||
HMODULE library = NULL;
|
||||
|
||||
if (CONSP (libraries) && NILP (Fassq (type, Vimage_type_cache)))
|
||||
{
|
||||
Lisp_Object dlls = Fassq (type, libraries);
|
||||
|
||||
if (CONSP (dlls))
|
||||
for (dlls = XCDR (dlls); CONSP (dlls); dlls = XCDR (dlls))
|
||||
{
|
||||
CHECK_STRING_CAR (dlls);
|
||||
if (library = LoadLibrary (SDATA (XCAR (dlls))))
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
return library;
|
||||
}
|
||||
|
||||
#endif /* HAVE_NTGUI */
|
||||
|
||||
static int x_create_x_image_and_pixmap (struct frame *, int, int, int,
|
||||
@ -5452,7 +5424,6 @@ init_png_functions (Lisp_Object libraries)
|
||||
{
|
||||
HMODULE library;
|
||||
|
||||
/* Try loading libpng under probable names. */
|
||||
if (!(library = w32_delayed_load (libraries, Qpng)))
|
||||
return 0;
|
||||
|
||||
@ -8633,10 +8604,12 @@ of `dynamic-library-alist', which see). */)
|
||||
{
|
||||
Lisp_Object tested;
|
||||
|
||||
#ifdef HAVE_NTGUI
|
||||
/* Don't try to reload the library. */
|
||||
tested = Fassq (type, Vimage_type_cache);
|
||||
tested = Fassq (type, Vlibrary_cache);
|
||||
if (CONSP (tested))
|
||||
return XCDR (tested);
|
||||
#endif
|
||||
|
||||
#if defined (HAVE_XPM) || defined (HAVE_NS)
|
||||
if (EQ (type, Qxpm))
|
||||
@ -8714,9 +8687,6 @@ as a ratio to the frame height and width. If the value is
|
||||
non-numeric, there is no explicit limit on the size of images. */);
|
||||
Vmax_image_size = make_float (MAX_IMAGE_SIZE);
|
||||
|
||||
Vimage_type_cache = Qnil;
|
||||
staticpro (&Vimage_type_cache);
|
||||
|
||||
Qpbm = intern_c_string ("pbm");
|
||||
staticpro (&Qpbm);
|
||||
ADD_IMAGE_TYPE (Qpbm);
|
||||
|
||||
@ -978,6 +978,7 @@ $(BLD)/image.$(O) : \
|
||||
$(SRC)/frame.h \
|
||||
$(SRC)/systime.h \
|
||||
$(SRC)/termhooks.h \
|
||||
$(SRC)/w32.h \
|
||||
$(SRC)/w32gui.h \
|
||||
$(SRC)/w32term.h \
|
||||
$(SRC)/window.h
|
||||
@ -1304,7 +1305,9 @@ $(BLD)/print.$(O) : \
|
||||
$(BLD)/process.$(O) : \
|
||||
$(SRC)/process.c \
|
||||
$(CONFIG_H) \
|
||||
$(EMACS_ROOT)/nt/inc/inttypes.h \
|
||||
$(EMACS_ROOT)/nt/inc/netdb.h \
|
||||
$(EMACS_ROOT)/nt/inc/stdint.h \
|
||||
$(EMACS_ROOT)/nt/inc/unistd.h \
|
||||
$(EMACS_ROOT)/nt/inc/arpa/inet.h \
|
||||
$(EMACS_ROOT)/nt/inc/netinet/in.h \
|
||||
|
||||
@ -1416,9 +1416,10 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
|
||||
DEFUN ("ns-read-file-name", Fns_read_file_name, Sns_read_file_name, 1, 4, 0,
|
||||
doc: /* Use a graphical panel to read a file name, using prompt PROMPT.
|
||||
Optional arg DIR, if non-nil, supplies a default directory.
|
||||
Optional arg ISLOAD, if non-nil, means read a file name for saving.
|
||||
Optional arg MUSTMATCH, if non-nil, means the returned file or
|
||||
directory must exist.
|
||||
Optional arg INIT, if non-nil, provides a default file name to use. */)
|
||||
(Lisp_Object prompt, Lisp_Object dir, Lisp_Object isLoad, Lisp_Object init)
|
||||
(Lisp_Object prompt, Lisp_Object dir, Lisp_Object mustmatch, Lisp_Object init)
|
||||
{
|
||||
static id fileDelegate = nil;
|
||||
int ret;
|
||||
@ -1443,7 +1444,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
|
||||
if ([dirS characterAtIndex: 0] == '~')
|
||||
dirS = [dirS stringByExpandingTildeInPath];
|
||||
|
||||
panel = NILP (isLoad) ?
|
||||
panel = NILP (mustmatch) ?
|
||||
(id)[EmacsSavePanel savePanel] : (id)[EmacsOpenPanel openPanel];
|
||||
|
||||
[panel setTitle: promptS];
|
||||
@ -1457,7 +1458,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
|
||||
|
||||
panelOK = 0;
|
||||
BLOCK_INPUT;
|
||||
if (NILP (isLoad))
|
||||
if (NILP (mustmatch))
|
||||
{
|
||||
ret = [panel runModalForDirectory: dirS file: initS];
|
||||
}
|
||||
|
||||
@ -32,6 +32,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
|
||||
#include <unistd.h>
|
||||
#include <fcntl.h>
|
||||
|
||||
#include "lisp.h"
|
||||
|
||||
/* Only MS-DOS does not define `subprocesses'. */
|
||||
#ifdef subprocesses
|
||||
|
||||
@ -76,7 +78,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
|
||||
|
||||
#endif /* subprocesses */
|
||||
|
||||
#include "lisp.h"
|
||||
#include "systime.h"
|
||||
#include "systty.h"
|
||||
|
||||
@ -4539,7 +4540,7 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
|
||||
if (nfds == 0 &&
|
||||
wait_proc && wait_proc->gnutls_p /* Check for valid process. */
|
||||
/* Do we have pending data? */
|
||||
&& gnutls_record_check_pending (wait_proc->gnutls_state) > 0)
|
||||
&& emacs_gnutls_record_check_pending (wait_proc->gnutls_state) > 0)
|
||||
{
|
||||
nfds = 1;
|
||||
/* Set to Available. */
|
||||
@ -4950,7 +4951,7 @@ read_process_output (Lisp_Object proc, register int channel)
|
||||
}
|
||||
#ifdef HAVE_GNUTLS
|
||||
if (XPROCESS (proc)->gnutls_p)
|
||||
nbytes = emacs_gnutls_read (channel, XPROCESS (proc),
|
||||
nbytes = emacs_gnutls_read (XPROCESS (proc),
|
||||
chars + carryover + buffered,
|
||||
readmax - buffered);
|
||||
else
|
||||
@ -5413,9 +5414,8 @@ send_process (volatile Lisp_Object proc, const char *volatile buf,
|
||||
{
|
||||
#ifdef HAVE_GNUTLS
|
||||
if (XPROCESS (proc)->gnutls_p)
|
||||
written = emacs_gnutls_write (outfd,
|
||||
XPROCESS (proc),
|
||||
buf, this);
|
||||
written = emacs_gnutls_write (XPROCESS (proc),
|
||||
buf, this);
|
||||
else
|
||||
#endif
|
||||
written = emacs_write (outfd, buf, this);
|
||||
|
||||
62
src/w32.c
62
src/w32.c
@ -150,6 +150,8 @@ typedef struct _PROCESS_MEMORY_COUNTERS_EX {
|
||||
typedef HRESULT (WINAPI * ShGetFolderPath_fn)
|
||||
(IN HWND, IN int, IN HANDLE, IN DWORD, OUT char *);
|
||||
|
||||
Lisp_Object QCloaded_from;
|
||||
|
||||
void globals_of_w32 (void);
|
||||
static DWORD get_rid (PSID);
|
||||
|
||||
@ -5712,6 +5714,54 @@ sys_localtime (const time_t *t)
|
||||
return localtime (t);
|
||||
}
|
||||
|
||||
|
||||
|
||||
/* Delayed loading of libraries. */
|
||||
|
||||
Lisp_Object Vlibrary_cache;
|
||||
|
||||
/* The argument LIBRARIES is an alist that associates a symbol
|
||||
LIBRARY_ID, identifying an external DLL library known to Emacs, to
|
||||
a list of filenames under which the library is usually found. In
|
||||
most cases, the argument passed as LIBRARIES is the variable
|
||||
`dynamic-library-alist', which is initialized to a list of common
|
||||
library names. If the function loads the library successfully, it
|
||||
returns the handle of the DLL, and records the filename in the
|
||||
property :loaded-from of LIBRARY_ID; it returns NULL if the library
|
||||
could not be found, or when it was already loaded (because the
|
||||
handle is not recorded anywhere, and so is lost after use). It
|
||||
would be trivial to save the handle too in :loaded-from, but
|
||||
currently there's no use case for it. */
|
||||
HMODULE
|
||||
w32_delayed_load (Lisp_Object libraries, Lisp_Object library_id)
|
||||
{
|
||||
HMODULE library_dll = NULL;
|
||||
|
||||
CHECK_SYMBOL (library_id);
|
||||
|
||||
if (CONSP (libraries) && NILP (Fassq (library_id, Vlibrary_cache)))
|
||||
{
|
||||
Lisp_Object found = Qnil;
|
||||
Lisp_Object dlls = Fassq (library_id, libraries);
|
||||
|
||||
if (CONSP (dlls))
|
||||
for (dlls = XCDR (dlls); CONSP (dlls); dlls = XCDR (dlls))
|
||||
{
|
||||
CHECK_STRING_CAR (dlls);
|
||||
if (library_dll = LoadLibrary (SDATA (XCAR (dlls))))
|
||||
{
|
||||
found = XCAR (dlls);
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
Fput (library_id, QCloaded_from, found);
|
||||
}
|
||||
|
||||
return library_dll;
|
||||
}
|
||||
|
||||
|
||||
static void
|
||||
check_windows_init_file (void)
|
||||
{
|
||||
@ -5910,6 +5960,12 @@ globals_of_w32 (void)
|
||||
get_process_times_fn = (GetProcessTimes_Proc)
|
||||
GetProcAddress (kernel32, "GetProcessTimes");
|
||||
|
||||
QCloaded_from = intern_c_string (":loaded-from");
|
||||
staticpro (&QCloaded_from);
|
||||
|
||||
Vlibrary_cache = Qnil;
|
||||
staticpro (&Vlibrary_cache);
|
||||
|
||||
g_b_init_is_windows_9x = 0;
|
||||
g_b_init_open_process_token = 0;
|
||||
g_b_init_get_token_information = 0;
|
||||
@ -6178,7 +6234,7 @@ emacs_gnutls_pull (gnutls_transport_ptr_t p, void* buf, size_t sz)
|
||||
err = errno; /* Other errors are just passed on. */
|
||||
}
|
||||
|
||||
gnutls_transport_set_errno (process->gnutls_state, err);
|
||||
emacs_gnutls_transport_set_errno (process->gnutls_state, err);
|
||||
|
||||
return -1;
|
||||
}
|
||||
@ -6197,8 +6253,8 @@ emacs_gnutls_push (gnutls_transport_ptr_t p, const void* buf, size_t sz)
|
||||
|
||||
/* Negative bytes written means we got an error in errno.
|
||||
Translate the WSAEWOULDBLOCK alias EWOULDBLOCK to EAGAIN. */
|
||||
gnutls_transport_set_errno (process->gnutls_state,
|
||||
errno == EWOULDBLOCK ? EAGAIN : errno);
|
||||
emacs_gnutls_transport_set_errno (process->gnutls_state,
|
||||
errno == EWOULDBLOCK ? EAGAIN : errno);
|
||||
|
||||
return -1;
|
||||
}
|
||||
|
||||
@ -143,6 +143,9 @@ extern void syms_of_fontset (void);
|
||||
extern int _sys_read_ahead (int fd);
|
||||
extern int _sys_wait_accept (int fd);
|
||||
|
||||
extern Lisp_Object Vlibrary_cache, QCloaded_from;
|
||||
extern HMODULE w32_delayed_load (Lisp_Object, Lisp_Object);
|
||||
|
||||
#ifdef HAVE_GNUTLS
|
||||
#include <gnutls/gnutls.h>
|
||||
|
||||
|
||||
@ -114,6 +114,7 @@ get_data_end (void)
|
||||
return data_region_end;
|
||||
}
|
||||
|
||||
#if !defined (USE_LISP_UNION_TYPE) && !defined (USE_LSB_TAG)
|
||||
static char *
|
||||
allocate_heap (void)
|
||||
{
|
||||
@ -140,9 +141,31 @@ allocate_heap (void)
|
||||
|
||||
return ptr;
|
||||
}
|
||||
#else /* USE_LISP_UNION_TYPE || USE_LSB_TAG */
|
||||
static char *
|
||||
allocate_heap (void)
|
||||
{
|
||||
unsigned long size = 0x80000000; /* start by asking for 2GB */
|
||||
void *ptr = NULL;
|
||||
|
||||
while (!ptr && size > 0x00100000)
|
||||
{
|
||||
reserved_heap_size = size;
|
||||
ptr = VirtualAlloc (NULL,
|
||||
get_reserved_heap_size (),
|
||||
MEM_RESERVE,
|
||||
PAGE_NOACCESS);
|
||||
size -= 0x00800000; /* if failed, decrease request by 8MB */
|
||||
}
|
||||
|
||||
return ptr;
|
||||
}
|
||||
#endif /* USE_LISP_UNION_TYPE || USE_LSB_TAG */
|
||||
|
||||
|
||||
/* Emulate Unix sbrk. */
|
||||
/* Emulate Unix sbrk. Note that ralloc.c expects the return value to
|
||||
be the address of the _start_ (not end) of the new block in case of
|
||||
success, and zero (not -1) in case of failure. */
|
||||
void *
|
||||
sbrk (unsigned long increment)
|
||||
{
|
||||
|
||||
Loading…
Reference in New Issue
Block a user