procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

merge master

Browse source
This commit is contained in:
Joakim Verona 2015-01-26 21:57:51 +01:00
commit d464b0ee30
27 changed files with 2963 additions and 1714 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
ChangeLog
View file

@ -1,3 +1,7 @@
2015-01-26 Paul Eggert <eggert@cs.ucla.edu>
* INSTALL.REPO: Mention minimum Git version.
2015-01-25 Paul Eggert <eggert@cs.ucla.edu>
Use gnustep-config if available

2
INSTALL.REPO
View file

@ -12,6 +12,8 @@ autoconf - at least the version specified near the start of
configure.ac (in the AC_PREREQ command).
automake - at least the version specified near the start of
configure.ac (in the AM_INIT_AUTOMAKE command).
git - at least Git 1.7.1. If your repository was created by an older
Git version, you may need to reclone it.
makeinfo - not strictly necessary, but highly recommended, so that
you can build the manuals.

5
etc/ChangeLog
View file

@ -1,3 +1,8 @@
2015-01-26 Lars Ingebrigtsen <larsi@gnus.org>
* publicsuffix.txt: Install an updated version of the file from
https://publicsuffix.org/list/effective_tld_names.dat.
2015-01-25 Paul Eggert <eggert@cs.ucla.edu>
Use gnustep-config if available

3485
etc/publicsuffix.txt
View file

File diff suppressed because it is too large Load diff

51
lisp/ChangeLog
View file

@ -1,3 +1,54 @@
2015-01-26 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/cl-generic.el (cl--generic-method): New struct.
(cl--generic): The method-table is now a (list-of cl--generic-method).
(cl--generic-member-method): New function.
(cl-generic-define-method): Use it.
(cl--generic-build-combined-method, cl--generic-cache-miss):
Adapt to new method-table.
(cl--generic-no-next-method-function): Add `method' argument.
(cl-generic-call-method): Adapt to new method representation.
(cl--generic-cnm-sample, cl--generic-nnm-sample): Adjust.
(cl-find-method, cl-method-qualifiers): New functions.
(cl--generic-method-info): Adapt to new method representation.
Return a string for the qualifiers.
(cl--generic-describe):
* emacs-lisp/eieio-opt.el (eieio-help-class): Adjust accordingly.
(eieio-all-generic-functions, eieio-method-documentation):
Adjust to new method representation.
* emacs-lisp/eieio-compat.el (eieio--defmethod): Use cl-find-method.
2015-01-26 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/cl-generic.el: Add a method-combination hook.
(cl-generic-method-combination-function): New var.
(cl--generic-lambda): Remove `with-cnm' arg.
(cl-defmethod): Change accordingly.
(cl-generic-define-method): Don't check qualifiers validity.
Preserve all qualifiers in `method-table'.
(cl-generic-call-method): New function.
(cl--generic-nest): Remove (morph into cl-generic-call-method).
(cl--generic-build-combined-method): Adjust to new format of method-table
and use cl-generic-method-combination-function.
(cl--generic-standard-method-combination): New function, extracted from
cl--generic-build-combined-method.
(cl--generic-cnm-sample): Adjust to new format of method-table.
* emacs-lisp/eieio-compat.el (eieio--defmethod): Use () qualifiers
instead of :primary.
* emacs-lisp/eieio-datadebug.el (eieio-debug-methodinvoke):
Remove obsolete function.
2015-01-26 Lars Ingebrigtsen <larsi@gnus.org>
* net/shr.el (shr-make-table-1): Fix colspan typo.
* net/eww.el (eww-add-bookmark): Fix prompt and clean up the code
slightly.
2015-01-25 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/cl-generic.el (cl--generic-no-next-method-function): New fun.

16
lisp/calculator.el
View file

@ -312,8 +312,8 @@ user-defined operators, use `calculator-user-operators' instead.")
It it possible have a unary prefix version of a binary operator if it
comes later in this list. If the list begins with the symbol 'nobind,
then no key binding will take place -- this is only useful for predefined
keys.
then no key binding will take place -- this is only useful for
predefined keys.
Use `calculator-user-operators' to add operators to this list, see its
documentation for an example.")
@ -1124,9 +1124,15 @@ If optional argument FORCE is non-nil, don't use the cached string."
" "
(and calculator-display-fragile
calculator-saved-list
(= (car calculator-stack)
(nth calculator-saved-ptr
calculator-saved-list))
;; Hack: use `eq' to compare the number: it's a
;; flonum, so `eq' means that its the actual
;; number rather than a computation that had an
;; equal result (eg, enter 1,3,2, use "v" to see
;; the average -- it now shows "2" instead of
;; "2 [3]").
(eq (car calculator-stack)
(nth calculator-saved-ptr
calculator-saved-list))
(if (= 0 calculator-saved-ptr)
(format "[%s]" (length calculator-saved-list))
(format "[%s/%s]"

321
lisp/emacs-lisp/cl-generic.el
View file

@ -30,11 +30,9 @@
;; CLOS's define-method-combination is IMO overly complicated, and it suffers
;; from a significant problem: the method-combination code returns a sexp
;; that needs to be `eval'uated or compiled. IOW it requires run-time
;; code generation.
;; - Method and generic function objects: CLOS defines methods as objects
;; (same for generic functions), whereas we don't offer such an abstraction.
;; - `no-next-method' should receive the "calling method" object, but since we
;; don't have such a thing, we pass nil instead.
;; code generation. Given how rarely method-combinations are used,
;; I just provided a cl-generic-method-combination-function, which
;; people can use if they are really desperate for such functionality.
;; - In defgeneric we don't support the options:
;; declare, :method-combination, :generic-function-class, :method-class,
;; :method.
@ -48,6 +46,8 @@
;; eieio-core adds dispatch on:
;; - class of eieio objects
;; - actual class argument, using the syntax (subclass <class>).
;; - cl-generic-method-combination-function (i.s.o define-method-combination).
;; - cl-generic-call-method (which replaces make-method and call-method).
;; Efficiency considerations: overall, I've made an effort to make this fairly
;; efficient for the expected case (e.g. no constant redefinition of methods).
@ -101,6 +101,18 @@ that for all other (PRIORITY . TAGCODE) where PRIORITY ≤ N, then
"Function to get the list of types that a given \"tag\" matches.
They should be sorted from most specific to least specific.")
(cl-defstruct (cl--generic-method
(:constructor nil)
(:constructor cl--generic-method-make
(specializers qualifiers uses-cnm function))
(:predicate nil))
(specializers nil :read-only t :type list)
(qualifiers nil :read-only t :type (list-of atom))
;; USES-CNM is a boolean indicating if FUNCTION expects an extra argument
;; holding the next-method.
(uses-cnm nil :read-only t :type boolean)
(function nil :read-only t :type function))
(cl-defstruct (cl--generic
(:constructor nil)
(:constructor cl--generic-make
@ -114,12 +126,7 @@ They should be sorted from most specific to least specific.")
;; decide in which order to sort them.
;; The most important dispatch is last in the list (and the least is first).
(dispatches nil :type (list-of (cons natnum (list-of tagcode))))
;; `method-table' is a list of
;; ((SPECIALIZERS . QUALIFIER) USES-CNM . FUNCTION), where
;; USES-CNM is a boolean indicating if FUNCTION calls `cl-call-next-method'
;; (and hence expects an extra argument holding the next-method).
(method-table nil :type (list-of (cons (cons (list-of type) keyword)
(cons boolean function)))))
(method-table nil :type (list-of cl--generic-method)))
(defmacro cl--generic (name)
`(get ,name 'cl--generic))
@ -232,7 +239,7 @@ This macro can only be used within the lexical scope of a cl-generic method."
(and (memq sexp vars) (not (memq sexp res)) (push sexp res))
res))
(defun cl--generic-lambda (args body with-cnm)
(defun cl--generic-lambda (args body)
"Make the lambda expression for a method with ARGS and BODY."
(let ((plain-args ())
(specializers nil)
@ -255,36 +262,34 @@ This macro can only be used within the lexical scope of a cl-generic method."
. ,(lambda () specializers))
macroexpand-all-environment)))
(require 'cl-lib) ;Needed to expand `cl-flet' and `cl-function'.
(if (not with-cnm)
(cons nil (macroexpand-all fun macroenv))
;; First macroexpand away the cl-function stuff (e.g. &key and
;; destructuring args, `declare' and whatnot).
(pcase (macroexpand fun macroenv)
(`#'(lambda ,args . ,body)
(let* ((doc-string (and doc-string (stringp (car body)) (cdr body)
(pop body)))
(cnm (make-symbol "cl--cnm"))
(nmp (make-symbol "cl--nmp"))
(nbody (macroexpand-all
`(cl-flet ((cl-call-next-method ,cnm)
(cl-next-method-p ,nmp))
,@body)
macroenv))
;; FIXME: Rather than `grep' after the fact, the
;; macroexpansion should directly set some flag when cnm
;; is used.
;; FIXME: Also, optimize the case where call-next-method is
;; only called with explicit arguments.
(uses-cnm (cl--generic-fgrep (list cnm nmp) nbody)))
(cons (not (not uses-cnm))
`#'(lambda (,@(if uses-cnm (list cnm)) ,@args)
,@(if doc-string (list doc-string))
,(if (not (memq nmp uses-cnm))
nbody
`(let ((,nmp (lambda ()
(cl--generic-isnot-nnm-p ,cnm))))
,nbody))))))
(f (error "Unexpected macroexpansion result: %S" f))))))))
;; First macroexpand away the cl-function stuff (e.g. &key and
;; destructuring args, `declare' and whatnot).
(pcase (macroexpand fun macroenv)
(`#'(lambda ,args . ,body)
(let* ((doc-string (and doc-string (stringp (car body)) (cdr body)
(pop body)))
(cnm (make-symbol "cl--cnm"))
(nmp (make-symbol "cl--nmp"))
(nbody (macroexpand-all
`(cl-flet ((cl-call-next-method ,cnm)
(cl-next-method-p ,nmp))
,@body)
macroenv))
;; FIXME: Rather than `grep' after the fact, the
;; macroexpansion should directly set some flag when cnm
;; is used.
;; FIXME: Also, optimize the case where call-next-method is
;; only called with explicit arguments.
(uses-cnm (cl--generic-fgrep (list cnm nmp) nbody)))
(cons (not (not uses-cnm))
`#'(lambda (,@(if uses-cnm (list cnm)) ,@args)
,@(if doc-string (list doc-string))
,(if (not (memq nmp uses-cnm))
nbody
`(let ((,nmp (lambda ()
(cl--generic-isnot-nnm-p ,cnm))))
,nbody))))))
(f (error "Unexpected macroexpansion result: %S" f)))))))
;;;###autoload
@ -324,8 +329,7 @@ which case this method will be invoked when the argument is `eql' to VAL.
(while (not (listp args))
(push args qualifiers)
(setq args (pop body)))
(pcase-let* ((with-cnm (not (memq (car qualifiers) '(:before :after))))
(`(,uses-cnm . ,fun) (cl--generic-lambda args body with-cnm)))
(pcase-let* ((`(,uses-cnm . ,fun) (cl--generic-lambda args body)))
`(progn
,(when setfizer
(setq name (car setfizer))
@ -345,19 +349,25 @@ which case this method will be invoked when the argument is `eql' to VAL.
(cl-generic-define-method ',name ',qualifiers ',args
,uses-cnm ,fun)))))
(defun cl--generic-member-method (specializers qualifiers methods)
(while
(and methods
(let ((m (car methods)))
(not (and (equal (cl--generic-method-specializers m) specializers)
(equal (cl--generic-method-qualifiers m) qualifiers)))))
(setq methods (cdr methods))
methods))
;;;###autoload
(defun cl-generic-define-method (name qualifiers args uses-cnm function)
(when (> (length qualifiers) 1)
(error "We only support a single qualifier per method: %S" qualifiers))
(unless (memq (car qualifiers) '(nil :primary :around :after :before))
(error "Unsupported qualifier in: %S" qualifiers))
(let* ((generic (cl-generic-ensure-function name))
(mandatory (cl--generic-mandatory-args args))
(specializers
(mapcar (lambda (arg) (if (consp arg) (cadr arg) t)) mandatory))
(key (cons specializers (or (car qualifiers) ':primary)))
(method (cl--generic-method-make
specializers qualifiers uses-cnm function))
(mt (cl--generic-method-table generic))
(me (assoc key mt))
(me (cl--generic-member-method specializers qualifiers mt))
(dispatches (cl--generic-dispatches generic))
(i 0))
(dolist (specializer specializers)
@ -372,9 +382,8 @@ which case this method will be invoked when the argument is `eql' to VAL.
(nreverse (sort (cons tagcode (cdr x))
#'car-less-than-car))))
(setq i (1+ i))))
(if me (setcdr me (cons uses-cnm function))
(setf (cl--generic-method-table generic)
(cons `(,key ,uses-cnm . ,function) mt)))
(if me (setcar me method)
(setf (cl--generic-method-table generic) (cons method mt)))
(cl-pushnew `(cl-defmethod . (,(cl--generic-name generic) . ,specializers))
current-load-list :test #'equal)
(let ((gfun (cl--generic-make-function generic))
@ -438,22 +447,19 @@ which case this method will be invoked when the argument is `eql' to VAL.
(cdr dispatch) (car dispatch))))
(funcall dispatcher generic dispatches)))))
(defun cl--generic-nest (fun methods)
(pcase-dolist (`(,uses-cnm . ,method) methods)
(setq fun
(if (not uses-cnm) method
(let ((next fun))
(lambda (&rest args)
(apply method
;; FIXME: This sucks: passing just `next' would
;; be a lot more efficient than the lambda+apply
;; quasi-η, but we need this to implement the
;; "if call-next-method is called with no
;; arguments, then use the previous arguments".
(lambda (&rest cnm-args)
(apply next (or cnm-args args)))
args))))))
fun)
(defvar cl-generic-method-combination-function
#'cl--generic-standard-method-combination
"Function to build the effective method.
Called with 2 arguments: NAME and METHOD-ALIST.
It should return an effective method, i.e. a function that expects the same
arguments as the methods, and calls those methods in some appropriate order.
NAME is the name (a symbol) of the corresponding generic function.
METHOD-ALIST is a list of elements (QUALIFIERS . METHODS) where
QUALIFIERS is a list of qualifiers, and METHODS is a list of the selected
methods for that qualifier list.
The METHODS lists are sorted from most generic first to most specific last.
The function can use `cl-generic-call-method' to create functions that call those
methods.")
(defvar cl--generic-combined-method-memoization
(make-hash-table :test #'equal :weakness 'value)
@ -462,54 +468,82 @@ This is particularly useful when many different tags select the same set
of methods, since this table then allows us to share a single combined-method
for all those different tags in the method-cache.")
(defun cl--generic-no-next-method-function (generic)
(lambda (&rest args)
;; FIXME: CLOS passes as second arg the "calling method".
;; We don't currently have "method objects" like CLOS
;; does so we can't really do it the CLOS way.
;; The closest would be to pass the lambda corresponding
;; to the method, or maybe the ((SPECIALIZERS
;; . QUALIFIER) USE-CNM . FUNCTION) entry from the method
;; table, but the caller wouldn't be able to do much with
;; it anyway. So we pass nil for now.
(apply #'cl-no-next-method generic nil args)))
(defun cl--generic-build-combined-method (generic-name methods)
(let ((mets-by-qual ()))
(dolist (qm methods)
(push (cdr qm) (alist-get (cdar qm) mets-by-qual)))
(cl--generic-with-memoization
(gethash (cons generic-name mets-by-qual)
cl--generic-combined-method-memoization)
(cond
((null mets-by-qual)
(lambda (&rest args)
(apply #'cl-no-applicable-method generic-name args)))
((null (alist-get :primary mets-by-qual))
(lambda (&rest args)
(apply #'cl-no-primary-method generic-name args)))
(t
(let* ((fun (cl--generic-no-next-method-function generic-name))
;; We use `cdr' to drop the `uses-cnm' annotations.
(before
(mapcar #'cdr (reverse (alist-get :before mets-by-qual))))
(after (mapcar #'cdr (alist-get :after mets-by-qual))))
(setq fun (cl--generic-nest fun (alist-get :primary mets-by-qual)))
(when (or after before)
(let ((next fun))
(setq fun (lambda (&rest args)
(dolist (bf before)
(apply bf args))
(prog1
(apply next args)
(dolist (af after)
(apply af args)))))))
(cl--generic-nest fun (alist-get :around mets-by-qual))))))))
(cl--generic-with-memoization
(gethash (cons generic-name methods)
cl--generic-combined-method-memoization)
(let ((mets-by-qual ()))
(dolist (method methods)
(let* ((qualifiers (cl--generic-method-qualifiers method))
(x (assoc qualifiers mets-by-qual)))
;; FIXME: sadly, alist-get only uses `assq' and we need `assoc'.
;;(push (cdr qm) (alist-get qualifiers mets-by-qual)))
(if x
(push method (cdr x))
(push (list qualifiers method) mets-by-qual))))
(funcall cl-generic-method-combination-function
generic-name mets-by-qual))))
(defconst cl--generic-nnm-sample (cl--generic-no-next-method-function 'dummy))
(defun cl--generic-no-next-method-function (generic method)
(lambda (&rest args)
(apply #'cl-no-next-method generic method args)))
(defun cl-generic-call-method (generic-name method &optional fun)
"Return a function that calls METHOD.
FUN is the function that should be called when METHOD calls
`call-next-method'."
(if (not (cl--generic-method-uses-cnm method))
(cl--generic-method-function method)
(let ((met-fun (cl--generic-method-function method))
(next (or fun (cl--generic-no-next-method-function
generic-name method))))
(lambda (&rest args)
(apply met-fun
;; FIXME: This sucks: passing just `next' would
;; be a lot more efficient than the lambda+apply
;; quasi-η, but we need this to implement the
;; "if call-next-method is called with no
;; arguments, then use the previous arguments".
(lambda (&rest cnm-args)
(apply next (or cnm-args args)))
args)))))
(defun cl--generic-standard-method-combination (generic-name mets-by-qual)
(dolist (x mets-by-qual)
(unless (member (car x) '(() (:after) (:before) (:around)))
(error "Unsupported qualifiers in function %S: %S" generic-name (car x))))
(cond
((null mets-by-qual)
(lambda (&rest args)
(apply #'cl-no-applicable-method generic-name args)))
((null (alist-get nil mets-by-qual))
(lambda (&rest args)
(apply #'cl-no-primary-method generic-name args)))
(t
(let* ((fun nil)
(ab-call (lambda (m) (cl-generic-call-method generic-name m)))
(before
(mapcar ab-call (reverse (cdr (assoc '(:before) mets-by-qual)))))
(after (mapcar ab-call (cdr (assoc '(:after) mets-by-qual)))))
(dolist (method (cdr (assoc nil mets-by-qual)))
(setq fun (cl-generic-call-method generic-name method fun)))
(when (or after before)
(let ((next fun))
(setq fun (lambda (&rest args)
(dolist (bf before)
(apply bf args))
(prog1
(apply next args)
(dolist (af after)
(apply af args)))))))
(dolist (method (cdr (assoc '(:around) mets-by-qual)))
(setq fun (cl-generic-call-method generic-name method fun)))
fun))))
(defconst cl--generic-nnm-sample (cl--generic-no-next-method-function t t))
(defconst cl--generic-cnm-sample
(funcall (cl--generic-build-combined-method
nil `(((specializer . :primary) t . ,#'identity)))))
nil (list (cl--generic-method-make () () t #'identity)))))
(defun cl--generic-isnot-nnm-p (cnm)
"Return non-nil if CNM is the function that calls `cl-no-next-method'."
@ -540,11 +574,13 @@ for all those different tags in the method-cache.")
(defun cl--generic-cache-miss (generic dispatch-arg dispatches-left tags)
(let ((types (apply #'append (mapcar cl-generic-tag-types-function tags)))
(methods '()))
(dolist (method-desc (cl--generic-method-table generic))
(let* ((specializer (or (nth dispatch-arg (caar method-desc)) t))
(dolist (method (cl--generic-method-table generic))
(let* ((specializer (or (nth dispatch-arg
(cl--generic-method-specializers method))
t))
(m (member specializer types)))
(when m
(push (cons (length m) method-desc) methods))))
(push (cons (length m) method) methods))))
;; Sort the methods, most specific first.
;; It would be tempting to sort them once and for all in the method-table
;; rather than here, but the order might depend on the actual argument
@ -587,6 +623,14 @@ Can only be used from within the lexical body of a primary or around method."
(declare (obsolete "make sure there's always a next method, or catch `cl-no-next-method' instead" "25.1"))
(error "cl-next-method-p only allowed inside primary and around methods"))
;;;###autoload
(defun cl-find-method (generic qualifiers specializers)
(car (cl--generic-member-method
specializers qualifiers
(cl--generic-method-table (cl--generic generic)))))
(defalias 'cl-method-qualifiers 'cl--generic-method-qualifiers)
;;; Add support for describe-function
(defun cl--generic-search-method (met-name)
@ -611,22 +655,30 @@ Can only be used from within the lexical body of a primary or around method."
`(cl-defmethod . ,#'cl--generic-search-method)))
(defun cl--generic-method-info (method)
(pcase-let ((`((,specializers . ,qualifier) ,uses-cnm . ,function) method))
(let* ((args (help-function-arglist function 'names))
(docstring (documentation function))
(doconly (if docstring
(let ((split (help-split-fundoc docstring nil)))
(if split (cdr split) docstring))))
(combined-args ()))
(if uses-cnm (setq args (cdr args)))
(dolist (specializer specializers)
(let ((arg (if (eq '&rest (car args))
(intern (format "arg%d" (length combined-args)))
(pop args))))
(push (if (eq specializer t) arg (list arg specializer))
combined-args)))
(setq combined-args (append (nreverse combined-args) args))
(list qualifier combined-args doconly))))
(let* ((specializers (cl--generic-method-specializers method))
(qualifiers (cl--generic-method-qualifiers method))
(uses-cnm (cl--generic-method-uses-cnm method))
(function (cl--generic-method-function method))
(args (help-function-arglist function 'names))
(docstring (documentation function))
(qual-string
(if (null qualifiers) ""
(cl-assert (consp qualifiers))
(let ((s (prin1-to-string qualifiers)))
(concat (substring s 1 -1) " "))))
(doconly (if docstring
(let ((split (help-split-fundoc docstring nil)))
(if split (cdr split) docstring))))
(combined-args ()))
(if uses-cnm (setq args (cdr args)))
(dolist (specializer specializers)
(let ((arg (if (eq '&rest (car args))
(intern (format "arg%d" (length combined-args)))
(pop args))))
(push (if (eq specializer t) arg (list arg specializer))
combined-args)))
(setq combined-args (append (nreverse combined-args) args))
(list qual-string combined-args doconly)))
(add-hook 'help-fns-describe-function-functions #'cl--generic-describe)
(defun cl--generic-describe (function)
@ -640,8 +692,9 @@ Can only be used from within the lexical body of a primary or around method."
(dolist (method (cl--generic-method-table generic))
(let* ((info (cl--generic-method-info method)))
;; FIXME: Add hyperlinks for the types as well.
(insert (format "%S %S" (nth 0 info) (nth 1 info)))
(let* ((met-name (cons function (caar method)))
(insert (format "%s%S" (nth 0 info) (nth 1 info)))
(let* ((met-name (cons function
(cl--generic-method-specializers method)))
(file (find-lisp-object-file-name met-name 'cl-defmethod)))
(when file
(insert " in `")

13
lisp/emacs-lisp/eieio-compat.el
View file

@ -181,7 +181,8 @@ Summary:
(lambda (generic arg &rest args) (apply code arg generic args)))
(_ code))))
(cl-generic-define-method
method (if kind (list kind)) specializers uses-cnm
method (unless (memq kind '(nil :primary)) (list kind))
specializers uses-cnm
(if uses-cnm
(let* ((docstring (documentation code 'raw))
(args (help-function-arglist code 'preserve-names))
@ -201,11 +202,11 @@ Summary:
;; applicable but only of the before/after kind. So if we add a :before
;; or :after, make sure there's a matching dummy primary.
(when (and (memq kind '(:before :after))
(not (assoc (cons (mapcar (lambda (arg)
(if (consp arg) (nth 1 arg) t))
specializers)
:primary)
(cl--generic-method-table (cl--generic method)))))
;; FIXME: Use `cl-find-method'?
(not (cl-find-method method ()
(mapcar (lambda (arg)
(if (consp arg) (nth 1 arg) t))
specializers))))
(cl-generic-define-method method () specializers t
(lambda (cnm &rest args)
(if (cl--generic-isnot-nnm-p cnm)

16
lisp/emacs-lisp/eieio-datadebug.el
View file

@ -129,22 +129,6 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
(data-debug-new-buffer (format "*%s DDEBUG*" (eieio-object-name obj)))
(data-debug-insert-object-slots obj "]"))
;;; DEBUG FUNCTIONS
;;
(defun eieio-debug-methodinvoke (method class)
"Show the method invocation order for METHOD with CLASS object."
(interactive "aMethod: \nXClass Expression: ")
(let* ((eieio-pre-method-execution-functions
(lambda (l) (throw 'moose l) ))
(data
(catch 'moose (eieio--generic-call
method (list class))))
(_buf (data-debug-new-buffer "*Method Invocation*"))
(data2 (mapcar (lambda (sym)
(symbol-function (car sym)))
data)))
(data-debug-insert-thing data2 ">" "")))
(provide 'eieio-datadebug)
;;; eieio-datadebug.el ends here

18
lisp/emacs-lisp/eieio-opt.el
View file

@ -129,9 +129,9 @@ If CLASS is actually an object, then also display current values of that object.
(insert "`")
(help-insert-xref-button (symbol-name generic) 'help-function generic)
(insert "'")
(pcase-dolist (`(,qualifier ,args ,doc)
(pcase-dolist (`(,qualifiers ,args ,doc)
(eieio-method-documentation generic class))
(insert (format " %S %S\n" qualifier args)
(insert (format " %s%S\n" qualifiers args)
(or doc "")))
(insert "\n\n")))))
@ -325,10 +325,9 @@ methods for CLASS."
(and generic
(catch 'found
(if (null class) (throw 'found t))
(pcase-dolist (`((,specializers . ,_qualifier) . ,_)
(cl--generic-method-table generic))
(dolist (method (cl--generic-method-table generic))
(if (eieio--specializers-apply-to-class-p
specializers class)
(cl--generic-method-specializers method) class)
(throw 'found t))))
(push symbol l)))))
l))
@ -336,15 +335,14 @@ methods for CLASS."
(defun eieio-method-documentation (generic class)
"Return info for all methods of GENERIC applicable to CLASS.
The value returned is a list of elements of the form
\(QUALIFIER ARGS DOC)."
\(QUALIFIERS ARGS DOC)."
(let ((generic (cl--generic generic))
(docs ()))
(when generic
(dolist (method (cl--generic-method-table generic))
(pcase-let ((`((,specializers . ,_qualifier) . ,_) method))
(when (eieio--specializers-apply-to-class-p
specializers class)
(push (cl--generic-method-info method) docs)))))
(when (eieio--specializers-apply-to-class-p
(cl--generic-method-specializers method) class)
(push (cl--generic-method-info method) docs))))
docs))
;;; METHOD STATS

29
lisp/gnus/ChangeLog
View file

@ -1,3 +1,32 @@
2015-01-26 Trevor Murphy <trevor.m.murphy@gmail.com>
* nnimap.el (nnimap-header-parameters): Refactor and request
X-GM-LABELS if it's been announced.
(nnimap-transform-headers): Gather and output GM-LABELS.
2015-01-26 Peder O. Klingenberg <peder@klingenberg.no>
* mm-decode.el (mm-display-part): Make non-string methods work.
Non-string methods are funcalled and work just fine, the test was
bogus.
* mm-decode.el (mm-display-external): Show "external" lisp viewers in
whole frame.
2015-01-26 Lars Ingebrigtsen <larsi@gnus.org>
* nnimap.el (nnimap-request-accept-article): Allow respooling using
nnimap.
* gnus-group.el (gnus-group-get-new-news-this-group): Explicitly
request rescans when being run interactively.
* nnimap.el (nnimap-request-group): Don't rescan the group here,
because that can be very slow in large groups.
* gnus-int.el (gnus-request-group-scan): New backend function.
* nnimap.el (nnimap-request-scan-group): Implement in on IMAP.
2015-01-25 Lars Ingebrigtsen <larsi@gnus.org>
* gnus-group.el (gnus-group-suspend): Close all backends.

4
lisp/gnus/gnus-group.el
View file

@ -4075,7 +4075,9 @@ If DONT-SCAN is non-nil, scan non-activated groups as well."
(gnus-group-remove-mark group)
;; Bypass any previous denials from the server.
(gnus-remove-denial (setq method (gnus-find-method-for-group group)))
(if (gnus-activate-group group (if dont-scan nil 'scan) nil method)
(if (or (and (not dont-scan)
(gnus-request-group-scan group (gnus-get-info group)))
(gnus-activate-group group (if dont-scan nil 'scan) nil method))
(let ((info (gnus-get-info group))
(active (gnus-active group)))
(when info

8
lisp/gnus/gnus-int.el
View file

@ -439,6 +439,14 @@ If it is down, start it up (again)."
(funcall (gnus-get-function gnus-command-method func)
(gnus-group-real-name group) (nth 1 gnus-command-method)))))
(defun gnus-request-group-scan (group info)
"Request that GROUP get a complete rescan."
(let ((gnus-command-method (gnus-find-method-for-group group))
(func 'request-group-description))
(when (gnus-check-backend-function func group)
(funcall (gnus-get-function gnus-command-method func)
(gnus-group-real-name group) (nth 1 gnus-command-method) info))))
(defun gnus-close-group (group)
"Request the GROUP be closed."
(let ((gnus-command-method (inline (gnus-find-method-for-group group))))

20
lisp/gnus/mm-decode.el
View file

@ -833,18 +833,18 @@ external if displayed external."
'inline)
(setq external
(and method ;; If nil, we always use "save".
(stringp method) ;; 'mailcap-save-binary-file
(or (eq mm-enable-external t)
(and (eq mm-enable-external 'ask)
(y-or-n-p
(concat
"Display part (" type
") using external program"
;; Can non-string method ever happen?
") "
(if (stringp method)
(concat
" \"" (format method filename) "\"")
"")
"using external program \""
(format method filename) "\"")
(format
"by calling `%s' on the contents)" method))
"? "))))))
(if external
(mm-display-external
@ -885,7 +885,15 @@ external if displayed external."
(mm-handle-media-type handle) t))))
(unwind-protect
(if method
(funcall method)
(progn
(when (and (boundp 'gnus-summary-buffer)
(bufferp gnus-summary-buffer)
(buffer-name gnus-summary-buffer))
;; So that we pop back to the right place, sortof.
(switch-to-buffer gnus-summary-buffer)
(switch-to-buffer mm))
(delete-other-windows)
(funcall method))
(mm-save-part handle))
(when (and (not non-viewer)
method)

137
lisp/gnus/nnimap.el
View file

@ -166,14 +166,21 @@ textual parts.")
(nnimap-find-process-buffer nntp-server-buffer))
(defun nnimap-header-parameters ()
(format "(UID RFC822.SIZE BODYSTRUCTURE %s)"
(format
(let (params)
(push "UID" params)
(push "RFC822.SIZE" params)
(when (nnimap-capability "X-GM-EXT-1")
(push "X-GM-LABELS" params))
(push "BODYSTRUCTURE" params)
(push (format
(if (nnimap-ver4-p)
"BODY.PEEK[HEADER.FIELDS %s]"
"RFC822.HEADER.LINES %s")
(append '(Subject From Date Message-Id
References In-Reply-To Xref)
nnmail-extra-headers))))
nnmail-extra-headers))
params)
(format "%s" (nreverse params))))
(deffoo nnimap-retrieve-headers (articles &optional group server fetch-old)
(when group
@ -197,7 +204,7 @@ textual parts.")
(defun nnimap-transform-headers ()
(goto-char (point-min))
(let (article lines size string)
(let (article lines size string labels)
(block nil
(while (not (eobp))
(while (not (looking-at "\\* [0-9]+ FETCH"))
@ -232,6 +239,9 @@ textual parts.")
t)
(match-string 1)))
(beginning-of-line)
(when (search-forward "X-GM-LABELS" (line-end-position) t)
(setq labels (ignore-errors (read (current-buffer)))))
(beginning-of-line)
(when (search-forward "BODYSTRUCTURE" (line-end-position) t)
(let ((structure (ignore-errors
(read (current-buffer)))))
@ -251,6 +261,8 @@ textual parts.")
(insert (format "Chars: %s\n" size)))
(when lines
(insert (format "Lines: %s\n" lines)))
(when labels
(insert (format "X-GM-LABELS: %s\n" labels)))
;; Most servers have a blank line after the headers, but
;; Davmail doesn't.
(unless (re-search-forward "^\r$\\|^)\r?$" nil t)
@ -792,43 +804,55 @@ textual parts.")
articles active marks high low)
(with-current-buffer nntp-server-buffer
(when result
(if (and dont-check
(setq active (nth 2 (assoc group nnimap-current-infos))))
(insert (format "211 %d %d %d %S\n"
(- (cdr active) (car active))
(car active)
(cdr active)
group))
(with-current-buffer (nnimap-buffer)
(erase-buffer)
(let ((group-sequence
(nnimap-send-command "SELECT %S" (utf7-encode group t)))
(flag-sequence
(nnimap-send-command "UID FETCH 1:* FLAGS")))
(setf (nnimap-group nnimap-object) group)
(nnimap-wait-for-response flag-sequence)
(setq marks
(nnimap-flags-to-marks
(nnimap-parse-flags
(list (list group-sequence flag-sequence
1 group "SELECT")))))
(when (and info
marks)
(nnimap-update-infos marks (list info))
(nnimap-store-info info (gnus-active (gnus-info-group info))))
(goto-char (point-max))
(let ((uidnext (nth 5 (car marks))))
(setq high (or (if uidnext
(1- uidnext)
(nth 3 (car marks)))
0)
low (or (nth 4 (car marks)) uidnext 1)))))
(erase-buffer)
(insert
(format
"211 %d %d %d %S\n" (1+ (- high low)) low high group)))
(when (or (not dont-check)
(not (setq active
(nth 2 (assoc group nnimap-current-infos)))))
(let ((sequences (nnimap-retrieve-group-data-early
server (list info))))
(nnimap-finish-retrieve-group-infos server (list info) sequences
t)
(setq active (nth 2 (assoc group nnimap-current-infos)))))
(insert (format "211 %d %d %d %S\n"
(- (cdr active) (car active))
(car active)
(cdr active)
group))
t))))
(deffoo nnimap-request-scan-group (group &optional server info)
(setq group (nnimap-decode-gnus-group group))
(let (marks high low)
(with-current-buffer (nnimap-buffer)
(erase-buffer)
(let ((group-sequence
(nnimap-send-command "SELECT %S" (utf7-encode group t)))
(flag-sequence
(nnimap-send-command "UID FETCH 1:* FLAGS")))
(setf (nnimap-group nnimap-object) group)
(nnimap-wait-for-response flag-sequence)
(setq marks
(nnimap-flags-to-marks
(nnimap-parse-flags
(list (list group-sequence flag-sequence
1 group "SELECT")))))
(when (and info
marks)
(nnimap-update-infos marks (list info))
(nnimap-store-info info (gnus-active (gnus-info-group info))))
(goto-char (point-max))
(let ((uidnext (nth 5 (car marks))))
(setq high (or (if uidnext
(1- uidnext)
(nth 3 (car marks)))
0)
low (or (nth 4 (car marks)) uidnext 1)))))
(with-current-buffer nntp-server-buffer
(erase-buffer)
(insert
(format
"211 %d %d %d %S\n" (1+ (- high low)) low high group))
t)))
(deffoo nnimap-request-create-group (group &optional server args)
(setq group (nnimap-decode-gnus-group group))
(when (nnimap-change-group nil server)
@ -1122,8 +1146,11 @@ If LIMIT, first try to limit the search to the N last articles."
(setq group
(caar
(nnmail-article-group
;; We don't really care about the article number, because
;; that's determined by the IMAP server later. So just
;; return the group name.
`(lambda (group)
(nnml-active-number group ,server))))))
(list (list group)))))))
(setq group (nnimap-decode-gnus-group group))
(when (nnimap-change-group nil server)
(nnmail-check-syntax)
@ -1371,7 +1398,8 @@ If LIMIT, first try to limit the search to the N last articles."
command
(nth 2 quirk))))
(deffoo nnimap-finish-retrieve-group-infos (server infos sequences)
(deffoo nnimap-finish-retrieve-group-infos (server infos sequences
&optional dont-insert)
(when (and sequences
(nnimap-change-group nil server t)
;; Check that the process is still alive.
@ -1391,19 +1419,20 @@ If LIMIT, first try to limit the search to the N last articles."
(nnimap-parse-flags
(nreverse sequences)))
infos)
;; Finally, just return something resembling an active file in
;; the nntp buffer, so that the agent can save the info, too.
(with-current-buffer nntp-server-buffer
(erase-buffer)
(dolist (info infos)
(let* ((group (gnus-info-group info))
(active (gnus-active group)))
(when active
(insert (format "%S %d %d y\n"
(decode-coding-string
(gnus-group-real-name group) 'utf-8)
(cdr active)
(car active)))))))))))
(unless dont-insert
;; Finally, just return something resembling an active file in
;; the nntp buffer, so that the agent can save the info, too.
(with-current-buffer nntp-server-buffer
(erase-buffer)
(dolist (info infos)
(let* ((group (gnus-info-group info))
(active (gnus-active group)))
(when active
(insert (format "%S %d %d y\n"
(decode-coding-string
(gnus-group-real-name group) 'utf-8)
(cdr active)
(car active))))))))))))
(defun nnimap-update-infos (flags infos)
(dolist (info infos)

25
lisp/net/eww.el
View file

@ -1430,24 +1430,23 @@ Differences in #targets are ignored."
(defvar eww-bookmarks nil)
(defun eww-add-bookmark ()
"Add the current page to the bookmarks."
"Bookmark the current page."
(interactive)
(eww-read-bookmarks)
(dolist (bookmark eww-bookmarks)
(when (equal (plist-get eww-data :url) (plist-get bookmark :url))
(user-error "Already bookmarked")))
(if (y-or-n-p "bookmark this page? ")
(progn
(let ((title (replace-regexp-in-string "[\n\t\r]" " "
(plist-get eww-data :title))))
(setq title (replace-regexp-in-string "\\` +\\| +\\'" "" title))
(push (list :url (plist-get eww-data :url)
:title title
:time (current-time-string))
eww-bookmarks))
(eww-write-bookmarks)
(message "Bookmarked %s (%s)" (plist-get eww-data :url)
(plist-get eww-data :title)))))
(when (y-or-n-p "Bookmark this page?")
(let ((title (replace-regexp-in-string "[\n\t\r]" " "
(plist-get eww-data :title))))
(setq title (replace-regexp-in-string "\\` +\\| +\\'" "" title))
(push (list :url (plist-get eww-data :url)
:title title
:time (current-time-string))
eww-bookmarks))
(eww-write-bookmarks)
(message "Bookmarked %s (%s)" (plist-get eww-data :url)
(plist-get eww-data :title))))
(defun eww-write-bookmarks ()
(with-temp-file (expand-file-name "eww-bookmarks" eww-bookmarks-directory)

2
lisp/net/shr.el
View file

@ -1660,7 +1660,7 @@ The preference is a float determined from `shr-prefer-media-type'."
(aref widths width-column)
10))
(when (and fill
(setq colspan (dom-attr column colspan)))
(setq colspan (dom-attr column 'colspan)))
(setq colspan (min (string-to-number colspan)
;; The colspan may be wrong, so
;; truncate it to the length of the

54
src/ChangeLog
View file

@ -1,5 +1,59 @@
2015-01-26 Andreas Schwab <schwab@linux-m68k.org>
* image.c (lookup_pixel_color): Reorder conditions that are
written backwards.
(x_to_xcolors): Likewise.
(x_detect_edges): Likewise.
(png_load_body): Likewise.
(gif_close): Likewise.
(gif_load): Likewise.
2015-01-25 Eli Zaretskii <eliz@gnu.org>
Use bool for boolean in w32term.c
* w32term.c (x_update_window_begin, x_update_window_end)
(x_update_end, x_after_update_window_line)
(x_set_glyph_string_gc, x_draw_glyph_string_background)
(x_draw_glyph_string_foreground)
(x_draw_composite_glyph_string_foreground)
(x_draw_glyphless_glyph_string_foreground)
(x_draw_image_glyph_string, x_draw_glyph_string)
(x_draw_stretch_glyph_string, note_mouse_movement)
(w32_mouse_position, x_scroll_bar_report_motion)
(x_horizontal_scroll_bar_report_motion, w32_read_socket)
(w32_set_vertical_scroll_bar, w32_set_horizontal_scroll_bar)
(w32_draw_window_cursor, x_new_font, x_set_offset)
(x_set_window_size, x_make_frame_invisible, x_iconify_frame): Use
bool where appropriate.
Use bool for boolean in w32fns.c
* w32fns.c (w32_defined_color, x_decode_color)
(Fxw_color_defined_p, Fxw_color_values, x_set_icon_type)
(x_set_menu_bar_lines, x_change_tool_bar_height)
(x_set_internal_border_width, x_explicitly_set_name)
(x_implicitly_set_name, Fx_create_frame, w32_window)
(x_create_tip_frame, Fx_show_tip): Use bool where appropriate.
2015-01-25 Paul Eggert <eggert@cs.ucla.edu>
Use bool for boolean in xfns.c
* xfaces.c (x_update_menu_appearance):
* xfns.c (x_real_positions, x_defined_color, x_decode_color)
(xg_set_icon, xg_set_icon_from_xpm_data, x_set_cursor_color)
(x_set_icon_type, x_set_icon_name, x_set_menu_bar_lines)
(x_change_tool_bar_height, x_set_internal_border_width)
(x_encode_text, x_set_name_internal, x_explicitly_set_name)
(x_implicitly_set_name, x_default_scroll_bar_color_parameter)
(hack_wm_protocols, xic_create_fontsetname, xic_free_xfontset)
(x_window, x_icon, Fx_wm_set_size_hint, Fx_create_frame)
(Fxw_color_defined_p, Fxw_color_values, x_create_tip_frame)
(Fx_show_tip, clean_up_file_dialog, Fx_file_dialog)
(clean_up_dialog, syms_of_xfns):
* xterm.h (xg_set_icon, xg_set_icon_from_xpm_data)
(xic_create_fontsetname):
Use bool for boolean.
* xfns.c: Include bitmaps/gray.xbm unconditionally.
Count MANY function args more reliably
* alloc.c (Fgc_status, purecopy, unbind_to, garbage_collect_1):
* buffer.c (Fbuffer_list, Fkill_buffer):

16
src/image.c
View file

@ -4423,7 +4423,7 @@ lookup_pixel_color (struct frame *f, unsigned long pixel)
Colormap cmap;
bool rc;
if (ct_colors_allocated_max <= ct_colors_allocated)
if (ct_colors_allocated >= ct_colors_allocated_max)
return FRAME_FOREGROUND_PIXEL (f);
#ifdef HAVE_X_WINDOWS
@ -4554,7 +4554,7 @@ x_to_xcolors (struct frame *f, struct image *img, bool rgb_p)
HGDIOBJ prev;
#endif /* HAVE_NTGUI */
if (min (PTRDIFF_MAX, SIZE_MAX) / sizeof *colors / img->width < img->height)
if (img->height > min (PTRDIFF_MAX, SIZE_MAX) / sizeof *colors / img->width)
memory_full (SIZE_MAX);
colors = xmalloc (sizeof *colors * img->width * img->height);
@ -4695,7 +4695,7 @@ x_detect_edges (struct frame *f, struct image *img, int *matrix, int color_adjus
#define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
if (min (PTRDIFF_MAX, SIZE_MAX) / sizeof *new / img->width < img->height)
if (img->height > min (PTRDIFF_MAX, SIZE_MAX) / sizeof *new / img->width)
memory_full (SIZE_MAX);
new = xmalloc (sizeof *new * img->width * img->height);
@ -5917,8 +5917,8 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c)
row_bytes = png_get_rowbytes (png_ptr, info_ptr);
/* Allocate memory for the image. */
if (min (PTRDIFF_MAX, SIZE_MAX) / sizeof *rows < height
|| min (PTRDIFF_MAX, SIZE_MAX) / sizeof *pixels / height < row_bytes)
if (height > min (PTRDIFF_MAX, SIZE_MAX) / sizeof *rows
|| row_bytes > min (PTRDIFF_MAX, SIZE_MAX) / sizeof *pixels / height)
memory_full (SIZE_MAX);
c->pixels = pixels = xmalloc (sizeof *pixels * row_bytes * height);
c->rows = rows = xmalloc (height * sizeof *rows);
@ -7235,7 +7235,7 @@ gif_image_p (Lisp_Object object)
# ifdef WINDOWSNT
/* GIF library details. */
# if 5 < GIFLIB_MAJOR + (1 <= GIFLIB_MINOR)
# if GIFLIB_MAJOR + (GIFLIB_MINOR >= 1) > 5
DEF_DLL_FN (int, DGifCloseFile, (GifFileType *, int *));
# else
DEF_DLL_FN (int, DGifCloseFile, (GifFileType *));
@ -7316,7 +7316,7 @@ gif_close (GifFileType *gif, int *err)
{
int retval;
#if 5 < GIFLIB_MAJOR + (1 <= GIFLIB_MINOR)
#if GIFLIB_MAJOR + (GIFLIB_MINOR >= 1) > 5
retval = DGifCloseFile (gif, err);
#else
retval = DGifCloseFile (gif);
@ -7471,7 +7471,7 @@ gif_load (struct frame *f, struct image *img)
int subimg_height = subimage->ImageDesc.Height;
int subimg_top = subimage->ImageDesc.Top;
int subimg_left = subimage->ImageDesc.Left;
if (! (0 <= subimg_width && 0 <= subimg_height
if (! (subimg_width >= 0 && subimg_height >= 0
&& 0 <= subimg_top && subimg_top <= height - subimg_height
&& 0 <= subimg_left && subimg_left <= width - subimg_width))
{

79
src/w32fns.c
View file

@ -1133,7 +1133,8 @@ gamma_correct (struct frame *f, COLORREF *color)
If ALLOC is nonzero, allocate a new colormap cell. */
int
w32_defined_color (struct frame *f, const char *color, XColor *color_def, int alloc)
w32_defined_color (struct frame *f, const char *color, XColor *color_def,
bool alloc_p)
{
register Lisp_Object tem;
COLORREF w32_color_ref;
@ -1167,7 +1168,7 @@ w32_defined_color (struct frame *f, const char *color, XColor *color_def, int al
entry = entry->next;
}
if (entry == NULL && alloc)
if (entry == NULL && alloc_p)
{
/* not already mapped, so add to list */
entry = xmalloc (sizeof (struct w32_palette_entry));
@ -1220,7 +1221,7 @@ x_decode_color (struct frame *f, Lisp_Object arg, int def)
/* w32_defined_color is responsible for coping with failures
by looking for a near-miss. */
if (w32_defined_color (f, SDATA (arg), &cdef, 1))
if (w32_defined_color (f, SDATA (arg), &cdef, true))
return cdef.pixel;
/* defined_color failed; return an ultimate default. */
@ -1524,7 +1525,7 @@ x_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
void
x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
int result;
bool result;
if (NILP (arg) && NILP (oldval))
return;
@ -1632,7 +1633,7 @@ x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldva
if (FRAME_X_WINDOW (f) != 0)
{
adjust_frame_size (f, -1, -1, 3, 0, Qinternal_border_width);
adjust_frame_size (f, -1, -1, 3, false, Qinternal_border_width);
if (FRAME_VISIBLE_P (f))
x_clear_under_internal_border (f);
@ -1678,7 +1679,7 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
of the outer rectangle (including decorations) unchanged, and a
second time because we want to keep the height of the inner
rectangle (without the decorations unchanged). */
adjust_frame_size (f, -1, -1, 2, 1, Qmenu_bar_lines);
adjust_frame_size (f, -1, -1, 2, true, Qmenu_bar_lines);
/* Not sure whether this is needed. */
x_clear_under_internal_border (f);
@ -1748,7 +1749,7 @@ x_change_tool_bar_height (struct frame *f, int height)
(!f->tool_bar_redisplayed_once ? 1
: (old_height == 0 || height == 0) ? 2
: 4),
0, Qtool_bar_lines);
false, Qtool_bar_lines);
/* adjust_frame_size might not have done anything, garbage frame
here. */
@ -1771,7 +1772,7 @@ x_change_tool_bar_height (struct frame *f, int height)
F->explicit_name is set, ignore the new name; otherwise, set it. */
void
x_set_name (struct frame *f, Lisp_Object name, int explicit)
x_set_name (struct frame *f, Lisp_Object name, bool explicit)
{
/* Make sure that requests from lisp code override requests from
Emacs redisplay code. */
@ -1826,7 +1827,7 @@ x_set_name (struct frame *f, Lisp_Object name, int explicit)
void
x_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
x_set_name (f, arg, 1);
x_set_name (f, arg, true);
}
/* This function should be called by Emacs redisplay code to set the
@ -1835,7 +1836,7 @@ x_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
void
x_implicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
x_set_name (f, arg, 0);
x_set_name (f, arg, false);
}
/* Change the title of frame F to NAME.
@ -4199,7 +4200,7 @@ my_create_tip_window (struct frame *f)
/* Create and set up the w32 window for frame F. */
static void
w32_window (struct frame *f, long window_prompting, int minibuffer_only)
w32_window (struct frame *f, long window_prompting, bool minibuffer_only)
{
block_input ();
@ -4418,7 +4419,7 @@ This function is an internal primitive--use `make-frame' instead. */)
struct frame *f;
Lisp_Object frame, tem;
Lisp_Object name;
int minibuffer_only = 0;
bool minibuffer_only = false;
long window_prompting = 0;
ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
@ -4478,12 +4479,12 @@ This function is an internal primitive--use `make-frame' instead. */)
else if (EQ (tem, Qonly))
{
f = make_minibuffer_frame ();
minibuffer_only = 1;
minibuffer_only = true;
}
else if (WINDOWP (tem))
f = make_frame_without_minibuffer (tem, kb, display);
else
f = make_frame (1);
f = make_frame (true);
XSETFRAME (frame, f);
@ -4520,12 +4521,12 @@ This function is an internal primitive--use `make-frame' instead. */)
/* Cast to UINT_PTR shuts up compiler warnings about cast to
pointer from integer of different size. */
f->output_data.w32->parent_desc = (Window) (UINT_PTR) XFASTINT (parent);
f->output_data.w32->explicit_parent = 1;
f->output_data.w32->explicit_parent = true;
}
else
{
f->output_data.w32->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
f->output_data.w32->explicit_parent = 0;
f->output_data.w32->explicit_parent = false;
}
/* Set the name; the functions to which we pass f expect the name to
@ -4533,12 +4534,12 @@ This function is an internal primitive--use `make-frame' instead. */)
if (EQ (name, Qunbound) || NILP (name))
{
fset_name (f, build_string (dpyinfo->w32_id_name));
f->explicit_name = 0;
f->explicit_name = false;
}
else
{
fset_name (f, name);
f->explicit_name = 1;
f->explicit_name = true;
/* Use the frame's title when getting resources for this frame. */
specbind (Qx_resource_name, name);
}
@ -4616,7 +4617,7 @@ This function is an internal primitive--use `make-frame' instead. */)
had one frame line vs one toolbar line which left us with a zero
root window height which was obviously wrong as well ... */
adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f),
FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, 1,
FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, true,
Qx_create_frame_1);
/* The X resources controlling the menu-bar and tool-bar are
@ -4651,7 +4652,7 @@ This function is an internal primitive--use `make-frame' instead. */)
f->output_data.w32->current_cursor = f->output_data.w32->nontext_cursor;
window_prompting = x_figure_window_size (f, parameters, 1);
window_prompting = x_figure_window_size (f, parameters, true);
tem = x_get_arg (dpyinfo, parameters, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
f->no_split = minibuffer_only || EQ (tem, Qt);
@ -4685,14 +4686,14 @@ This function is an internal primitive--use `make-frame' instead. */)
/* Allow x_set_window_size, now. */
f->can_x_set_window_size = true;
adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), 0, 1,
adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), 0, true,
Qx_create_frame_2);
/* Tell the server what size and position, etc, we want, and how
badly we want them. This should be done after we have the menu
bar so that its size can be taken into account. */
block_input ();
x_wm_set_size_hint (f, window_prompting, 0);
x_wm_set_size_hint (f, window_prompting, false);
unblock_input ();
/* Make the window appear on the frame and enable display, unless
@ -4762,7 +4763,7 @@ DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
CHECK_STRING (color);
if (w32_defined_color (f, SDATA (color), &foo, 0))
if (w32_defined_color (f, SDATA (color), &foo, false))
return Qt;
else
return Qnil;
@ -4777,7 +4778,7 @@ DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
CHECK_STRING (color);
if (w32_defined_color (f, SDATA (color), &foo, 0))
if (w32_defined_color (f, SDATA (color), &foo, false))
return list3i ((GetRValue (foo.pixel) << 8) | GetRValue (foo.pixel),
(GetGValue (foo.pixel) << 8) | GetGValue (foo.pixel),
(GetBValue (foo.pixel) << 8) | GetBValue (foo.pixel));
@ -5647,7 +5648,7 @@ x_create_tip_frame (struct w32_display_info *dpyinfo,
frame = Qnil;
GCPRO3 (parms, name, frame);
/* Make a frame without minibuffer nor mode-line. */
f = make_frame (0);
f = make_frame (false);
f->wants_modeline = 0;
XSETFRAME (frame, f);
@ -5655,7 +5656,7 @@ x_create_tip_frame (struct w32_display_info *dpyinfo,
buffer = Fget_buffer_create (tip);
/* Use set_window_buffer instead of Fset_window_buffer (see
discussion of bug#11984, bug#12025, bug#12026). */
set_window_buffer (FRAME_ROOT_WINDOW (f), buffer, 0, 0);
set_window_buffer (FRAME_ROOT_WINDOW (f), buffer, false, false);
old_buffer = current_buffer;
set_buffer_internal_1 (XBUFFER (buffer));
bset_truncate_lines (current_buffer, Qnil);
@ -5685,19 +5686,19 @@ x_create_tip_frame (struct w32_display_info *dpyinfo,
#endif /* GLYPH_DEBUG */
FRAME_KBOARD (f) = kb;
f->output_data.w32->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
f->output_data.w32->explicit_parent = 0;
f->output_data.w32->explicit_parent = false;
/* Set the name; the functions to which we pass f expect the name to
be set. */
if (EQ (name, Qunbound) || NILP (name))
{
fset_name (f, build_string (dpyinfo->w32_id_name));
f->explicit_name = 0;
f->explicit_name = false;
}
else
{
fset_name (f, name);
f->explicit_name = 1;
f->explicit_name = true;
/* use the frame's title when getting resources for this frame. */
specbind (Qx_resource_name, name);
}
@ -5758,7 +5759,7 @@ x_create_tip_frame (struct w32_display_info *dpyinfo,
f->output_data.w32->dwStyle = WS_BORDER | WS_POPUP | WS_DISABLED;
f->output_data.w32->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
window_prompting = x_figure_window_size (f, parms, 0);
window_prompting = x_figure_window_size (f, parms, false);
/* No fringes on tip frame. */
f->fringe_cols = 0;
@ -5786,7 +5787,7 @@ x_create_tip_frame (struct w32_display_info *dpyinfo,
SET_FRAME_COLS (f, 0);
SET_FRAME_LINES (f, 0);
adjust_frame_size (f, width * FRAME_COLUMN_WIDTH (f),
height * FRAME_LINE_HEIGHT (f), 0, 1, Qnil);
height * FRAME_LINE_HEIGHT (f), 0, true, Qnil);
/* Add `tooltip' frame parameter's default value. */
if (NILP (Fframe_parameter (frame, Qtooltip)))
@ -5818,7 +5819,7 @@ x_create_tip_frame (struct w32_display_info *dpyinfo,
Fmodify_frame_parameters (frame, colors);
}
f->no_split = 1;
f->no_split = true;
UNGCPRO;
@ -5965,7 +5966,8 @@ Text larger than the specified size is clipped. */)
int root_x, root_y;
struct buffer *old_buffer;
struct text_pos pos;
int i, width, height, seen_reversed_p;
int i, width, height;
bool seen_reversed_p;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
int old_windows_or_buffers_changed = windows_or_buffers_changed;
ptrdiff_t count = SPECPDL_INDEX ();
@ -6094,7 +6096,7 @@ Text larger than the specified size is clipped. */)
FRAME_TOTAL_COLS (f) = WINDOW_TOTAL_COLS (w);
adjust_frame_glyphs (f);
w->pseudo_window_p = 1;
w->pseudo_window_p = true;
/* Display the tooltip text in a temporary buffer. */
old_buffer = current_buffer;
@ -6106,7 +6108,8 @@ Text larger than the specified size is clipped. */)
try_window (FRAME_ROOT_WINDOW (f), pos, TRY_WINDOW_IGNORE_FONTS_CHANGE);
/* Compute width and height of the tooltip. */
width = height = seen_reversed_p = 0;
width = height = 0;
seen_reversed_p = false;
for (i = 0; i < w->desired_matrix->nrows; ++i)
{
struct glyph_row *row = &w->desired_matrix->rows[i];
@ -6118,7 +6121,7 @@ Text larger than the specified size is clipped. */)
break;
/* Let the row go over the full width of the frame. */
row->full_width_p = 1;
row->full_width_p = true;
row_width = row->pixel_width;
if (row->used[TEXT_AREA])
@ -6142,7 +6145,7 @@ Text larger than the specified size is clipped. */)
if (g->type == STRETCH_GLYPH && NILP (g->object))
{
row_width -= g->pixel_width;
seen_reversed_p = 1;
seen_reversed_p = true;
}
}
}
@ -6183,7 +6186,7 @@ Text larger than the specified size is clipped. */)
if (!row->enabled_p || !MATRIX_ROW_DISPLAYS_TEXT_P (row))
break;
row->full_width_p = 1;
row->full_width_p = true;
row_width = row->pixel_width;
if (row->used[TEXT_AREA] && !row->reversed_p)
{

119
src/w32term.c
View file

@ -559,7 +559,7 @@ x_update_window_begin (struct window *w)
if (f == hlinfo->mouse_face_mouse_frame)
{
/* Don't do highlighting for mouse motion during the update. */
hlinfo->mouse_face_defer = 1;
hlinfo->mouse_face_defer = true;
/* If F needs to be redrawn, simply forget about any prior mouse
highlighting. */
@ -682,11 +682,11 @@ x_update_window_end (struct window *w, bool cursor_on_p,
block_input ();
if (cursor_on_p)
display_and_set_cursor (w, 1,
display_and_set_cursor (w, true,
w->output_cursor.hpos, w->output_cursor.vpos,
w->output_cursor.x, w->output_cursor.y);
if (draw_window_fringes (w, 1))
if (draw_window_fringes (w, true))
{
if (WINDOW_RIGHT_DIVIDER_WIDTH (w))
x_draw_right_divider (w);
@ -728,7 +728,7 @@ x_update_end (struct frame *f)
return;
/* Mouse highlight may be displayed again. */
MOUSE_HL_INFO (f)->mouse_face_defer = 0;
MOUSE_HL_INFO (f)->mouse_face_defer = false;
}
@ -758,7 +758,7 @@ x_after_update_window_line (struct window *w, struct glyph_row *desired_row)
eassert (w);
if (!desired_row->mode_line_p && !w->pseudo_window_p)
desired_row->redraw_fringe_bitmaps_p = 1;
desired_row->redraw_fringe_bitmaps_p = true;
/* When a window has disappeared, make sure that no rest of
full-width rows stays visible in the internal border. Could
@ -903,7 +903,7 @@ w32_destroy_fringe_bitmap (int which)
static void x_set_glyph_string_clipping (struct glyph_string *);
static void x_set_glyph_string_gc (struct glyph_string *);
static void x_draw_glyph_string_background (struct glyph_string *,
int);
bool);
static void x_draw_glyph_string_foreground (struct glyph_string *);
static void x_draw_composite_glyph_string_foreground (struct glyph_string *);
static void x_draw_glyph_string_box (struct glyph_string *);
@ -925,7 +925,7 @@ static void w32_draw_relief_rect (struct frame *, int, int, int, int,
int, int, int, int, int, int,
RECT *);
static void w32_draw_box_rect (struct glyph_string *, int, int, int, int,
int, int, int, RECT *);
int, bool, bool, RECT *);
/* Set S->gc to a suitable GC for drawing glyph string S in cursor
@ -1064,7 +1064,7 @@ x_set_glyph_string_gc (struct glyph_string *s)
else if (s->hl == DRAW_CURSOR)
{
x_set_cursor_gc (s);
s->stippled_p = 0;
s->stippled_p = false;
}
else if (s->hl == DRAW_MOUSE_FACE)
{
@ -1190,7 +1190,7 @@ x_clear_glyph_string_rect (struct glyph_string *s,
contains the first component of a composition. */
static void
x_draw_glyph_string_background (struct glyph_string *s, int force_p)
x_draw_glyph_string_background (struct glyph_string *s, bool force_p)
{
/* Nothing to do if background has already been drawn or if it
shouldn't be drawn in the first place. */
@ -1208,7 +1208,7 @@ x_draw_glyph_string_background (struct glyph_string *s, int force_p)
s->background_width,
s->height - 2 * box_line_width);
XSetFillStyle (s->display, s->gc, FillSolid);
s->background_filled_p = 1;
s->background_filled_p = true;
}
else
#endif
@ -1220,7 +1220,7 @@ x_draw_glyph_string_background (struct glyph_string *s, int force_p)
x_clear_glyph_string_rect (s, s->x, s->y + box_line_width,
s->background_width,
s->height - 2 * box_line_width);
s->background_filled_p = 1;
s->background_filled_p = true;
}
}
}
@ -1273,11 +1273,11 @@ x_draw_glyph_string_foreground (struct glyph_string *s)
y = s->ybase - boff;
if (s->for_overlaps
|| (s->background_filled_p && s->hl != DRAW_CURSOR))
font->driver->draw (s, 0, s->nchars, x, y, 0);
font->driver->draw (s, 0, s->nchars, x, y, false);
else
font->driver->draw (s, 0, s->nchars, x, y, 1);
font->driver->draw (s, 0, s->nchars, x, y, true);
if (s->face->overstrike)
font->driver->draw (s, 0, s->nchars, x + 1, y, 0);
font->driver->draw (s, 0, s->nchars, x + 1, y, false);
SelectObject (s->hdc, old_font);
}
@ -1331,9 +1331,9 @@ x_draw_composite_glyph_string_foreground (struct glyph_string *s)
int xx = x + s->cmp->offsets[j * 2];
int yy = y - s->cmp->offsets[j * 2 + 1];
font->driver->draw (s, j, j + 1, xx, yy, 0);
font->driver->draw (s, j, j + 1, xx, yy, false);
if (s->face->overstrike)
font->driver->draw (s, j, j + 1, xx + 1, yy, 0);
font->driver->draw (s, j, j + 1, xx + 1, yy, false);
}
SelectObject (s->hdc, old_font);
}
@ -1358,20 +1358,20 @@ x_draw_composite_glyph_string_foreground (struct glyph_string *s)
if (j < i)
{
font->driver->draw (s, j, i, x, y, 0);
font->driver->draw (s, j, i, x, y, false);
x += width;
}
xoff = LGLYPH_XOFF (glyph);
yoff = LGLYPH_YOFF (glyph);
wadjust = LGLYPH_WADJUST (glyph);
font->driver->draw (s, i, i + 1, x + xoff, y + yoff, 0);
font->driver->draw (s, i, i + 1, x + xoff, y + yoff, false);
x += wadjust;
j = i + 1;
width = 0;
}
}
if (j < i)
font->driver->draw (s, j, i, x, y, 0);
font->driver->draw (s, j, i, x, y, false);
SelectObject (s->hdc, old_font);
}
@ -1386,7 +1386,7 @@ x_draw_glyphless_glyph_string_foreground (struct glyph_string *s)
struct glyph *glyph = s->first_glyph;
XChar2b char2b[8];
int x, i, j;
int with_background;
bool with_background;
/* If first glyph of S has a left box line, start drawing the text
of S to the right of that box line. */
@ -1401,8 +1401,8 @@ x_draw_glyphless_glyph_string_foreground (struct glyph_string *s)
SetTextAlign (s->hdc, TA_BASELINE | TA_LEFT);
s->char2b = char2b;
with_background = ! (s->for_overlaps
|| (s->background_filled_p && s->hl != DRAW_CURSOR));
with_background = ((s->for_overlaps
|| (s->background_filled_p && s->hl != DRAW_CURSOR))) == 0;
for (i = 0; i < s->nchars; i++, glyph++)
{
char buf[7], *str = NULL;
@ -1712,7 +1712,7 @@ w32_draw_relief_rect (struct frame *f,
static void
w32_draw_box_rect (struct glyph_string *s,
int left_x, int top_y, int right_x, int bottom_y, int width,
int left_p, int right_p, RECT *clip_rect)
bool left_p, bool right_p, RECT *clip_rect)
{
w32_set_clip_rectangle (s->hdc, clip_rect);
@ -1747,8 +1747,8 @@ w32_draw_box_rect (struct glyph_string *s,
static void
x_draw_glyph_string_box (struct glyph_string *s)
{
int width, left_x, right_x, top_y, bottom_y, last_x, raised_p;
int left_p, right_p;
int width, left_x, right_x, top_y, bottom_y, last_x;
bool left_p, right_p, raised_p;
struct glyph *last_glyph;
RECT clip_rect;
@ -2157,7 +2157,7 @@ x_draw_image_glyph_string (struct glyph_string *s)
#endif
x_draw_glyph_string_bg_rect (s, x, y, width, height);
s->background_filled_p = 1;
s->background_filled_p = true;
}
/* Draw the foreground. */
@ -2293,7 +2293,7 @@ x_draw_stretch_glyph_string (struct glyph_string *s)
x_draw_glyph_string_bg_rect (s, x, s->y, background_width, s->height);
}
s->background_filled_p = 1;
s->background_filled_p = true;
}
@ -2321,7 +2321,7 @@ x_draw_glyph_string (struct glyph_string *s)
if (next->first_glyph->type == STRETCH_GLYPH)
x_draw_stretch_glyph_string (next);
else
x_draw_glyph_string_background (next, 1);
x_draw_glyph_string_background (next, true);
next->num_clips = 0;
}
}
@ -2338,7 +2338,7 @@ x_draw_glyph_string (struct glyph_string *s)
{
x_set_glyph_string_clipping (s);
x_draw_glyph_string_background (s, 1);
x_draw_glyph_string_background (s, true);
x_draw_glyph_string_box (s);
x_set_glyph_string_clipping (s);
relief_drawn_p = 1;
@ -2366,26 +2366,26 @@ x_draw_glyph_string (struct glyph_string *s)
case CHAR_GLYPH:
if (s->for_overlaps)
s->background_filled_p = 1;
s->background_filled_p = true;
else
x_draw_glyph_string_background (s, 0);
x_draw_glyph_string_background (s, false);
x_draw_glyph_string_foreground (s);
break;
case COMPOSITE_GLYPH:
if (s->for_overlaps || (s->cmp_from > 0
&& ! s->first_glyph->u.cmp.automatic))
s->background_filled_p = 1;
s->background_filled_p = true;
else
x_draw_glyph_string_background (s, 1);
x_draw_glyph_string_background (s, true);
x_draw_composite_glyph_string_foreground (s);
break;
case GLYPHLESS_GLYPH:
if (s->for_overlaps)
s->background_filled_p = 1;
s->background_filled_p = true;
else
x_draw_glyph_string_background (s, 0);
x_draw_glyph_string_background (s, false);
x_draw_glyphless_glyph_string_foreground (s);
break;
@ -3302,7 +3302,7 @@ note_mouse_movement (struct frame *frame, MSG *msg)
if (msg->hwnd != FRAME_W32_WINDOW (frame))
{
frame->mouse_moved = 1;
frame->mouse_moved = true;
dpyinfo->last_mouse_scroll_bar = NULL;
note_mouse_highlight (frame, -1, -1);
dpyinfo->last_mouse_glyph_frame = NULL;
@ -3315,7 +3315,7 @@ note_mouse_movement (struct frame *frame, MSG *msg)
|| mouse_x < r->left || mouse_x >= r->right
|| mouse_y < r->top || mouse_y >= r->bottom)
{
frame->mouse_moved = 1;
frame->mouse_moved = true;
dpyinfo->last_mouse_scroll_bar = NULL;
note_mouse_highlight (frame, mouse_x, mouse_y);
/* Remember the mouse position here, as w32_mouse_position only
@ -3399,7 +3399,7 @@ w32_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window,
/* Clear the mouse-moved flag for every frame on this display. */
FOR_EACH_FRAME (tail, frame)
XFRAME (frame)->mouse_moved = 0;
XFRAME (frame)->mouse_moved = false;
dpyinfo->last_mouse_scroll_bar = NULL;
@ -3822,7 +3822,7 @@ w32_set_vertical_scroll_bar (struct window *w,
}
unblock_input ();
bar = x_scroll_bar_create (w, left, top, width, height, 0);
bar = x_scroll_bar_create (w, left, top, width, height, false);
}
else
{
@ -3922,7 +3922,7 @@ w32_set_horizontal_scroll_bar (struct window *w,
}
unblock_input ();
bar = x_scroll_bar_create (w, left, top, width, height, 1);
bar = x_scroll_bar_create (w, left, top, width, height, true);
}
else
{
@ -4405,7 +4405,7 @@ x_scroll_bar_report_motion (struct frame **fp, Lisp_Object *bar_window,
XSETINT (*x, pos);
XSETINT (*y, top_range);
f->mouse_moved = 0;
f->mouse_moved = false;
dpyinfo->last_mouse_scroll_bar = NULL;
*time = dpyinfo->last_mouse_movement_time;
@ -4456,7 +4456,7 @@ x_horizontal_scroll_bar_report_motion (struct frame **fp, Lisp_Object *bar_windo
XSETINT (*y, pos);
XSETINT (*x, left_range);
f->mouse_moved = 0;
f->mouse_moved = false;
dpyinfo->last_mouse_scroll_bar = NULL;
*time = dpyinfo->last_mouse_movement_time;
@ -4596,7 +4596,7 @@ w32_read_socket (struct terminal *terminal,
/* Definitely not obscured, so mark as visible. */
SET_FRAME_VISIBLE (f, 1);
SET_FRAME_ICONIFIED (f, 0);
SET_FRAME_ICONIFIED (f, false);
SET_FRAME_GARBAGED (f);
if (!f->output_data.w32->asked_for_visible)
DebPrint (("frame %p (%s) reexposed by WM_PAINT\n", f,
@ -4658,7 +4658,7 @@ w32_read_socket (struct terminal *terminal,
&& !EQ (f->tool_bar_window, hlinfo->mouse_face_window))
{
clear_mouse_face (hlinfo);
hlinfo->mouse_face_hidden = 1;
hlinfo->mouse_face_hidden = true;
}
if (temp_index == sizeof temp_buffer / sizeof (short))
@ -4683,7 +4683,7 @@ w32_read_socket (struct terminal *terminal,
&& !EQ (f->tool_bar_window, hlinfo->mouse_face_window))
{
clear_mouse_face (hlinfo);
hlinfo->mouse_face_hidden = 1;
hlinfo->mouse_face_hidden = true;
}
if (temp_index == sizeof temp_buffer / sizeof (short))
@ -4761,7 +4761,7 @@ w32_read_socket (struct terminal *terminal,
&& !EQ (f->tool_bar_window, hlinfo->mouse_face_window))
{
clear_mouse_face (hlinfo);
hlinfo->mouse_face_hidden = 1;
hlinfo->mouse_face_hidden = true;
}
if (temp_index == sizeof temp_buffer / sizeof (short))
@ -4794,7 +4794,7 @@ w32_read_socket (struct terminal *terminal,
if (hlinfo->mouse_face_hidden)
{
hlinfo->mouse_face_hidden = 0;
hlinfo->mouse_face_hidden = false;
clear_mouse_face (hlinfo);
}
@ -4913,7 +4913,7 @@ w32_read_socket (struct terminal *terminal,
the ButtonPress. */
if (f != 0)
{
f->mouse_moved = 0;
f->mouse_moved = false;
if (!tool_bar_p)
f->last_tool_bar_item = -1;
}
@ -4940,7 +4940,7 @@ w32_read_socket (struct terminal *terminal,
event; any subsequent mouse-movement Emacs events
should reflect only motion after the
ButtonPress. */
f->mouse_moved = 0;
f->mouse_moved = false;
f->last_tool_bar_item = -1;
}
dpyinfo->last_mouse_frame = f;
@ -5041,7 +5041,7 @@ w32_read_socket (struct terminal *terminal,
{
case SIZE_MINIMIZED:
SET_FRAME_VISIBLE (f, 0);
SET_FRAME_ICONIFIED (f, 1);
SET_FRAME_ICONIFIED (f, true);
inev.kind = ICONIFY_EVENT;
XSETFRAME (inev.frame_or_window, f);
@ -5052,7 +5052,7 @@ w32_read_socket (struct terminal *terminal,
bool iconified = FRAME_ICONIFIED_P (f);
SET_FRAME_VISIBLE (f, 1);
SET_FRAME_ICONIFIED (f, 0);
SET_FRAME_ICONIFIED (f, false);
/* wait_reading_process_output will notice this
and update the frame's display structures. */
@ -5099,7 +5099,7 @@ w32_read_socket (struct terminal *terminal,
conditional again in revision 116727. martin */
if (iconified)
SET_FRAME_VISIBLE (f, 1);
SET_FRAME_ICONIFIED (f, 0);
SET_FRAME_ICONIFIED (f, false);
/* wait_reading_process_output will notice this
and update the frame's display structures. */
@ -5636,7 +5636,7 @@ w32_draw_window_cursor (struct window *w, struct glyph_row *glyph_row,
w->phys_cursor_type = cursor_type;
}
w->phys_cursor_on_p = 1;
w->phys_cursor_on_p = true;
/* If this is the active cursor, we need to track it with the
system caret, so third party software like screen magnifiers
@ -5674,7 +5674,7 @@ w32_draw_window_cursor (struct window *w, struct glyph_row *glyph_row,
? (w->phys_cursor.hpos < 0)
: (w->phys_cursor.hpos >= glyph_row->used[TEXT_AREA])))
{
glyph_row->cursor_in_fringe_p = 1;
glyph_row->cursor_in_fringe_p = true;
draw_fringe_bitmap (w, glyph_row, glyph_row->reversed_p);
return;
}
@ -5838,7 +5838,8 @@ x_new_font (struct frame *f, Lisp_Object font_object, int fontset)
problems because the tip frame has no widget. */
if (NILP (tip_frame) || XFRAME (tip_frame) != f)
adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f),
FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 3, 0, Qfont);
FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 3,
false, Qfont);
}
/* X version sets font of input methods here also. */
@ -5945,7 +5946,7 @@ x_set_offset (struct frame *f, register int xoff, register int yoff,
x_calc_absolute_position (f);
block_input ();
x_wm_set_size_hint (f, (long) 0, 0);
x_wm_set_size_hint (f, (long) 0, false);
modified_left = f->left_pos;
modified_top = f->top_pos;
@ -6140,7 +6141,7 @@ x_set_window_size (struct frame *f, bool change_gravity,
}
f->win_gravity = NorthWestGravity;
x_wm_set_size_hint (f, (long) 0, 0);
x_wm_set_size_hint (f, (long) 0, false);
f->want_fullscreen = FULLSCREEN_NONE;
w32fullscreen_hook (f);
@ -6452,7 +6453,7 @@ x_make_frame_invisible (struct frame *f)
FRAME_SAMPLE_VISIBILITY set this. So do it by hand,
and synchronize with the server to make sure we agree. */
SET_FRAME_VISIBLE (f, 0);
SET_FRAME_ICONIFIED (f, 0);
SET_FRAME_ICONIFIED (f, false);
unblock_input ();
}
@ -6477,7 +6478,7 @@ x_iconify_frame (struct frame *f)
SendMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, SC_MINIMIZE, 0);
SET_FRAME_VISIBLE (f, 0);
SET_FRAME_ICONIFIED (f, 1);
SET_FRAME_ICONIFIED (f, true);
unblock_input ();
}

2
src/w32term.h
View file

@ -239,7 +239,7 @@ Lisp_Object display_x_get_resource (struct w32_display_info *,
extern struct w32_display_info *w32_term_init (Lisp_Object,
char *, char *);
extern int w32_defined_color (struct frame *f, const char *color,
XColor *color_def, int alloc);
XColor *color_def, bool alloc_p);
extern void x_set_window_size (struct frame *f, bool change_gravity,
int width, int height, bool pixelwise);
extern int x_display_pixel_height (struct w32_display_info *);

4
src/xfaces.c
View file

@ -3489,7 +3489,7 @@ x_update_menu_appearance (struct frame *f)
Lisp_Object xlfd = Ffont_xlfd_name (LFACE_FONT (lface), Qnil);
#ifdef USE_MOTIF
const char *suffix = "List";
Bool motif = True;
bool motif = true;
#else
#if defined HAVE_X_I18N
@ -3497,7 +3497,7 @@ x_update_menu_appearance (struct frame *f)
#else
const char *suffix = "";
#endif
Bool motif = False;
bool motif = false;
#endif
if (! NILP (xlfd))

219
src/xfns.c
View file

@ -46,12 +46,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <sys/types.h>
#include <sys/stat.h>
#if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
#include "bitmaps/gray.xbm"
#else
#include <X11/bitmaps/gray>
#endif
#include "xsettings.h"
#ifdef HAVE_XRANDR
@ -182,7 +177,7 @@ x_real_positions (struct frame *f, int *xptr, int *yptr)
{
int win_x, win_y, outer_x IF_LINT (= 0), outer_y IF_LINT (= 0);
int real_x = 0, real_y = 0;
int had_errors = 0;
bool had_errors = false;
Window win = f->output_data.x->parent_desc;
Atom actual_type;
unsigned long actual_size, bytes_remaining;
@ -386,7 +381,7 @@ bool
x_defined_color (struct frame *f, const char *color_name,
XColor *color, bool alloc_p)
{
bool success_p = 0;
bool success_p = false;
Display *dpy = FRAME_X_DISPLAY (f);
Colormap cmap = FRAME_X_COLORMAP (f);
@ -415,9 +410,9 @@ x_decode_color (struct frame *f, Lisp_Object color_name, int mono_color)
CHECK_STRING (color_name);
#if 0 /* Don't do this. It's wrong when we're not using the default
colormap, it makes freeing difficult, and it's probably not
an important optimization. */
#if false /* Don't do this. It's wrong when we're not using the default
colormap, it makes freeing difficult, and it's probably not
an important optimization. */
if (strcmp (SDATA (color_name), "black") == 0)
return BLACK_PIX_DEFAULT (f);
else if (strcmp (SDATA (color_name), "white") == 0)
@ -430,7 +425,7 @@ x_decode_color (struct frame *f, Lisp_Object color_name, int mono_color)
/* x_defined_color is responsible for coping with failures
by looking for a near-miss. */
if (x_defined_color (f, SSDATA (color_name), &cdef, 1))
if (x_defined_color (f, SSDATA (color_name), &cdef, true))
return cdef.pixel;
signal_error ("Undefined color", color_name);
@ -477,10 +472,10 @@ x_set_tool_bar_position (struct frame *f,
/* Set icon from FILE for frame F. By using GTK functions the icon
may be any format that GdkPixbuf knows about, i.e. not just bitmaps. */
int
bool
xg_set_icon (struct frame *f, Lisp_Object file)
{
int result = 0;
bool result = false;
Lisp_Object found;
found = x_find_image_file (file);
@ -500,7 +495,7 @@ xg_set_icon (struct frame *f, Lisp_Object file)
pixbuf);
g_object_unref (pixbuf);
result = 1;
result = true;
}
else
g_error_free (err);
@ -511,17 +506,17 @@ xg_set_icon (struct frame *f, Lisp_Object file)
return result;
}
int
bool
xg_set_icon_from_xpm_data (struct frame *f, const char **data)
{
GdkPixbuf *pixbuf = gdk_pixbuf_new_from_xpm_data (data);
if (!pixbuf)
return 0;
return false;
gtk_window_set_icon (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), pixbuf);
g_object_unref (pixbuf);
return 1;
return true;
}
#endif /* USE_GTK */
@ -778,20 +773,20 @@ static void
x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
unsigned long fore_pixel, pixel;
bool fore_pixel_allocated_p = 0, pixel_allocated_p = 0;
bool fore_pixel_allocated_p = false, pixel_allocated_p = false;
struct x_output *x = f->output_data.x;
if (!NILP (Vx_cursor_fore_pixel))
{
fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
WHITE_PIX_DEFAULT (f));
fore_pixel_allocated_p = 1;
fore_pixel_allocated_p = true;
}
else
fore_pixel = FRAME_BACKGROUND_PIXEL (f);
pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
pixel_allocated_p = 1;
pixel_allocated_p = true;
/* Make sure that the cursor color differs from the background color. */
if (pixel == FRAME_BACKGROUND_PIXEL (f))
@ -799,7 +794,7 @@ x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
if (pixel_allocated_p)
{
x_free_colors (f, &pixel, 1);
pixel_allocated_p = 0;
pixel_allocated_p = false;
}
pixel = x->mouse_pixel;
@ -808,7 +803,7 @@ x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
if (fore_pixel_allocated_p)
{
x_free_colors (f, &fore_pixel, 1);
fore_pixel_allocated_p = 0;
fore_pixel_allocated_p = false;
}
fore_pixel = FRAME_BACKGROUND_PIXEL (f);
}
@ -833,8 +828,8 @@ x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
if (FRAME_VISIBLE_P (f))
{
x_update_cursor (f, 0);
x_update_cursor (f, 1);
x_update_cursor (f, false);
x_update_cursor (f, true);
}
}
@ -894,7 +889,7 @@ x_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
static void
x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
int result;
bool result;
if (STRINGP (arg))
{
@ -926,7 +921,7 @@ x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
static void
x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
int result;
bool result;
if (STRINGP (arg))
{
@ -992,7 +987,7 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
FRAME_EXTERNAL_MENU_BAR (f) = 1;
if (FRAME_X_P (f) && f->output_data.x->menubar_widget == 0)
/* Make sure next redisplay shows the menu bar. */
XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = 1;
XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = true;
}
else
{
@ -1005,7 +1000,7 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
#else /* not USE_X_TOOLKIT && not USE_GTK */
FRAME_MENU_BAR_LINES (f) = nlines;
FRAME_MENU_BAR_HEIGHT (f) = nlines * FRAME_LINE_HEIGHT (f);
adjust_frame_size (f, -1, -1, 2, 1, Qmenu_bar_lines);
adjust_frame_size (f, -1, -1, 2, true, Qmenu_bar_lines);
if (FRAME_X_WINDOW (f))
x_clear_under_internal_border (f);
@ -1084,17 +1079,17 @@ x_change_tool_bar_height (struct frame *f, int height)
FRAME_TOOL_BAR_HEIGHT (f) = 0;
if (height)
{
FRAME_EXTERNAL_TOOL_BAR (f) = 1;
FRAME_EXTERNAL_TOOL_BAR (f) = true;
if (FRAME_X_P (f) && f->output_data.x->toolbar_widget == 0)
/* Make sure next redisplay shows the tool bar. */
XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = 1;
XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = true;
update_frame_tool_bar (f);
}
else
{
if (FRAME_EXTERNAL_TOOL_BAR (f))
free_frame_tool_bar (f);
FRAME_EXTERNAL_TOOL_BAR (f) = 0;
FRAME_EXTERNAL_TOOL_BAR (f) = false;
}
#else /* !USE_GTK */
int unit = FRAME_LINE_HEIGHT (f);
@ -1134,7 +1129,7 @@ x_change_tool_bar_height (struct frame *f, int height)
(!f->tool_bar_redisplayed_once ? 1
: (old_height == 0 || height == 0) ? 2
: 4),
0, Qtool_bar_lines);
false, Qtool_bar_lines);
/* adjust_frame_size might not have done anything, garbage frame
here. */
@ -1166,7 +1161,7 @@ x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldva
if (FRAME_X_WINDOW (f) != 0)
{
adjust_frame_size (f, -1, -1, 3, 0, Qinternal_border_width);
adjust_frame_size (f, -1, -1, 3, false, Qinternal_border_width);
#ifdef USE_GTK
xg_clear_under_internal_border (f);
@ -1271,14 +1266,14 @@ x_set_scroll_bar_background (struct frame *f, Lisp_Object value, Lisp_Object old
Store the byte length of resulting text in *TEXT_BYTES.
If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
If the text contains only ASCII and Latin-1, store true in *STRING_P,
which means that the `encoding' of the result can be `STRING'.
Otherwise store 0 in *STRINGP, which means that the `encoding' of
Otherwise store false in *STRINGP, which means that the `encoding' of
the result should be `COMPOUND_TEXT'. */
static unsigned char *
x_encode_text (Lisp_Object string, Lisp_Object coding_system,
ptrdiff_t *text_bytes, int *stringp, bool *freep)
ptrdiff_t *text_bytes, bool *stringp, bool *freep)
{
int result = string_xstring_p (string);
struct coding_system coding;
@ -1287,8 +1282,8 @@ x_encode_text (Lisp_Object string, Lisp_Object coding_system,
{
/* No multibyte character in OBJ. We need not encode it. */
*text_bytes = SBYTES (string);
*stringp = 1;
*freep = 0;
*stringp = true;
*freep = false;
return SDATA (string);
}
@ -1302,7 +1297,7 @@ x_encode_text (Lisp_Object string, Lisp_Object coding_system,
SCHARS (string), SBYTES (string), Qnil);
*text_bytes = coding.produced;
*stringp = (result == 1 || !EQ (coding_system, Qcompound_text));
*freep = 1;
*freep = true;
return coding.destination;
}
@ -1320,8 +1315,8 @@ x_set_name_internal (struct frame *f, Lisp_Object name)
{
XTextProperty text, icon;
ptrdiff_t bytes;
int stringp;
bool do_free_icon_value = 0, do_free_text_value = 0;
bool stringp;
bool do_free_icon_value = false, do_free_text_value = false;
Lisp_Object coding_system;
Lisp_Object encoded_name;
Lisp_Object encoded_icon_name;
@ -1469,7 +1464,7 @@ x_set_name (struct frame *f, Lisp_Object name, bool explicit)
static void
x_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
x_set_name (f, arg, 1);
x_set_name (f, arg, true);
}
/* This function should be called by Emacs redisplay code to set the
@ -1478,7 +1473,7 @@ x_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
void
x_implicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
x_set_name (f, arg, 0);
x_set_name (f, arg, false);
}
/* Change the title of frame F to NAME.
@ -1557,7 +1552,7 @@ static Lisp_Object
x_default_scroll_bar_color_parameter (struct frame *f,
Lisp_Object alist, Lisp_Object prop,
const char *xprop, const char *xclass,
int foreground_p)
bool foreground_p)
{
struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
Lisp_Object tem;
@ -1614,9 +1609,9 @@ hack_wm_protocols (struct frame *f, Widget widget)
{
Display *dpy = XtDisplay (widget);
Window w = XtWindow (widget);
int need_delete = 1;
int need_focus = 1;
int need_save = 1;
bool need_delete = true;
bool need_focus = true;
bool need_save = true;
block_input ();
{
@ -1640,20 +1635,20 @@ hack_wm_protocols (struct frame *f, Widget widget)
nitems--;
if (atoms[nitems]
== FRAME_DISPLAY_INFO (f)->Xatom_wm_delete_window)
need_delete = 0;
need_delete = false;
else if (atoms[nitems]
== FRAME_DISPLAY_INFO (f)->Xatom_wm_take_focus)
need_focus = 0;
need_focus = false;
else if (atoms[nitems]
== FRAME_DISPLAY_INFO (f)->Xatom_wm_save_yourself)
need_save = 0;
need_save = false;
}
}
if (catoms)
XFree (catoms);
}
{
Atom props [10];
Atom props[10];
int count = 0;
if (need_delete)
props[count++] = FRAME_DISPLAY_INFO (f)->Xatom_wm_delete_window;
@ -1705,7 +1700,7 @@ static const char xic_default_fontset[] = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
/* Create an Xt fontset spec from the name of a base font.
If `motif' is True use the Motif syntax. */
char *
xic_create_fontsetname (const char *base_fontname, int motif)
xic_create_fontsetname (const char *base_fontname, bool motif)
{
const char *sep = motif ? ";" : ",";
char *fontsetname;
@ -1947,7 +1942,7 @@ void
xic_free_xfontset (struct frame *f)
{
Lisp_Object rest, frame;
bool shared_p = 0;
bool shared_p = false;
if (!FRAME_XIC_FONTSET (f))
return;
@ -1960,7 +1955,7 @@ xic_free_xfontset (struct frame *f)
&& FRAME_DISPLAY_INFO (cf) == FRAME_DISPLAY_INFO (f)
&& FRAME_XIC_FONTSET (cf) == FRAME_XIC_FONTSET (f))
{
shared_p = 1;
shared_p = true;
break;
}
}
@ -2220,7 +2215,7 @@ xic_set_xfontset (struct frame *f, const char *base_fontname)
/* Create and set up the X widget for frame F. */
static void
x_window (struct frame *f, long window_prompting, int minibuffer_only)
x_window (struct frame *f, long window_prompting)
{
XClassHint class_hints;
XSetWindowAttributes attributes;
@ -2228,7 +2223,7 @@ x_window (struct frame *f, long window_prompting, int minibuffer_only)
Widget shell_widget;
Widget pane_widget;
Widget frame_widget;
Arg al [25];
Arg al[25];
int ac;
block_input ();
@ -2298,8 +2293,8 @@ x_window (struct frame *f, long window_prompting, int minibuffer_only)
+ f->output_data.x->menubar_widget->core.border_width)
: 0);
#if 0 /* Experimentally, we now get the right results
for -geometry -0-0 without this. 24 Aug 96, rms. */
#if false /* Experimentally, we now get the right results
for -geometry -0-0 without this. 24 Aug 96, rms. */
if (FRAME_EXTERNAL_MENU_BAR (f))
{
Dimension ibw = 0;
@ -2328,9 +2323,9 @@ x_window (struct frame *f, long window_prompting, int minibuffer_only)
We pass that information later, in x_wm_set_size_hints. */
{
int left = f->left_pos;
int xneg = window_prompting & XNegative;
bool xneg = (window_prompting & XNegative) != 0;
int top = f->top_pos;
int yneg = window_prompting & YNegative;
bool yneg = (window_prompting & YNegative) != 0;
if (xneg)
left = -left;
if (yneg)
@ -2429,7 +2424,7 @@ x_window (struct frame *f, long window_prompting, int minibuffer_only)
Lisp_Object name;
bool explicit = f->explicit_name;
f->explicit_name = 0;
f->explicit_name = false;
name = f->name;
fset_name (f, Qnil);
x_set_name (f, name, explicit);
@ -2568,7 +2563,7 @@ x_window (struct frame *f)
Lisp_Object name;
bool explicit = f->explicit_name;
f->explicit_name = 0;
f->explicit_name = false;
name = f->name;
fset_name (f, Qnil);
x_set_name (f, name, explicit);
@ -2614,15 +2609,12 @@ x_icon_verify (struct frame *f, Lisp_Object parms)
static void
x_icon (struct frame *f, Lisp_Object parms)
{
Lisp_Object icon_x, icon_y;
#if 0
struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
#endif
/* Set the position of the icon. Note that twm groups all
icons in an icon window. */
icon_x = x_frame_get_and_record_arg (f, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
icon_y = x_frame_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
Lisp_Object icon_x
= x_frame_get_and_record_arg (f, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
Lisp_Object icon_y
= x_frame_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
{
CHECK_TYPE_RANGED_INTEGER (int, icon_x);
@ -2636,9 +2628,10 @@ x_icon (struct frame *f, Lisp_Object parms)
if (! EQ (icon_x, Qunbound))
x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
#if 0 /* x_get_arg removes the visibility parameter as a side effect,
but x_create_frame still needs it. */
#if false /* x_get_arg removes the visibility parameter as a side effect,
but x_create_frame still needs it. */
/* Start up iconic or window? */
struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
x_wm_set_window_state
(f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL),
Qicon)
@ -2866,7 +2859,7 @@ Signal error if FRAME is not an X frame. */)
struct frame *f = decode_window_system_frame (frame);
block_input ();
x_wm_set_size_hint (f, 0, 0);
x_wm_set_size_hint (f, 0, false);
unblock_input ();
return Qnil;
}
@ -2906,7 +2899,7 @@ This function is an internal primitive--use `make-frame' instead. */)
struct frame *f;
Lisp_Object frame, tem;
Lisp_Object name;
int minibuffer_only = 0;
bool minibuffer_only = false;
long window_prompting = 0;
ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
@ -2960,12 +2953,12 @@ This function is an internal primitive--use `make-frame' instead. */)
else if (EQ (tem, Qonly))
{
f = make_minibuffer_frame ();
minibuffer_only = 1;
minibuffer_only = true;
}
else if (WINDOWP (tem))
f = make_frame_without_minibuffer (tem, kb, display);
else
f = make_frame (1);
f = make_frame (true);
XSETFRAME (frame, f);
@ -3032,12 +3025,12 @@ This function is an internal primitive--use `make-frame' instead. */)
if (!NILP (parent))
{
f->output_data.x->parent_desc = (Window) XFASTINT (parent);
f->output_data.x->explicit_parent = 1;
f->output_data.x->explicit_parent = true;
}
else
{
f->output_data.x->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
f->output_data.x->explicit_parent = 0;
f->output_data.x->explicit_parent = false;
}
/* Set the name; the functions to which we pass f expect the name to
@ -3045,12 +3038,12 @@ This function is an internal primitive--use `make-frame' instead. */)
if (EQ (name, Qunbound) || NILP (name))
{
fset_name (f, build_string (dpyinfo->x_id_name));
f->explicit_name = 0;
f->explicit_name = false;
}
else
{
fset_name (f, name);
f->explicit_name = 1;
f->explicit_name = true;
/* Use the frame's title when getting resources for this frame. */
specbind (Qx_resource_name, name);
}
@ -3137,10 +3130,10 @@ This function is an internal primitive--use `make-frame' instead. */)
x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_foreground,
"scrollBarForeground",
"ScrollBarForeground", 1);
"ScrollBarForeground", true);
x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_background,
"scrollBarBackground",
"ScrollBarBackground", 0);
"ScrollBarBackground", false);
#ifdef GLYPH_DEBUG
image_cache_refcount =
@ -3163,7 +3156,7 @@ This function is an internal primitive--use `make-frame' instead. */)
had one frame line vs one toolbar line which left us with a zero
root window height which was obviously wrong as well ... */
adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f),
FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, 1,
FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, true,
Qx_create_frame_1);
/* Set the menu-bar-lines and tool-bar-lines parameters. We don't
@ -3193,7 +3186,7 @@ This function is an internal primitive--use `make-frame' instead. */)
FRAME_TOOL_BAR_POSITION (f), 0, 0, RES_TYPE_SYMBOL);
/* Compute the size of the X window. */
window_prompting = x_figure_window_size (f, parms, 1);
window_prompting = x_figure_window_size (f, parms, true);
tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
f->no_split = minibuffer_only || EQ (tem, Qt);
@ -3202,7 +3195,7 @@ This function is an internal primitive--use `make-frame' instead. */)
/* Create the X widget or window. */
#ifdef USE_X_TOOLKIT
x_window (f, window_prompting, minibuffer_only);
x_window (f, window_prompting);
#else
x_window (f);
#endif
@ -3238,7 +3231,7 @@ This function is an internal primitive--use `make-frame' instead. */)
/* Consider frame official, now. */
f->can_x_set_window_size = true;
adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), 0, 1,
adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), 0, true,
Qx_create_frame_2);
#if defined (USE_X_TOOLKIT) || defined (USE_GTK)
@ -3263,7 +3256,7 @@ This function is an internal primitive--use `make-frame' instead. */)
badly we want them. This should be done after we have the menu
bar so that its size can be taken into account. */
block_input ();
x_wm_set_size_hint (f, window_prompting, 0);
x_wm_set_size_hint (f, window_prompting, false);
unblock_input ();
/* Make the window appear on the frame and enable display, unless
@ -3392,7 +3385,7 @@ DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
CHECK_STRING (color);
if (x_defined_color (f, SSDATA (color), &foo, 0))
if (x_defined_color (f, SSDATA (color), &foo, false))
return Qt;
else
return Qnil;
@ -3407,7 +3400,7 @@ DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
CHECK_STRING (color);
if (x_defined_color (f, SSDATA (color), &foo, 0))
if (x_defined_color (f, SSDATA (color), &foo, false))
return list3i (foo.red, foo.green, foo.blue);
else
return Qnil;
@ -4946,14 +4939,14 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
frame = Qnil;
GCPRO3 (parms, name, frame);
f = make_frame (1);
f = make_frame (true);
XSETFRAME (frame, f);
AUTO_STRING (tip, " *tip*");
buffer = Fget_buffer_create (tip);
/* Use set_window_buffer instead of Fset_window_buffer (see
discussion of bug#11984, bug#12025, bug#12026). */
set_window_buffer (FRAME_ROOT_WINDOW (f), buffer, 0, 0);
set_window_buffer (FRAME_ROOT_WINDOW (f), buffer, false, false);
old_buffer = current_buffer;
set_buffer_internal_1 (XBUFFER (buffer));
bset_truncate_lines (current_buffer, Qnil);
@ -4987,7 +4980,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
fset_icon_name (f, Qnil);
FRAME_DISPLAY_INFO (f) = dpyinfo;
f->output_data.x->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
f->output_data.x->explicit_parent = 0;
f->output_data.x->explicit_parent = false;
/* These colors will be set anyway later, but it's important
to get the color reference counts right, so initialize them! */
@ -5027,12 +5020,12 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
if (EQ (name, Qunbound) || NILP (name))
{
fset_name (f, build_string (dpyinfo->x_id_name));
f->explicit_name = 0;
f->explicit_name = false;
}
else
{
fset_name (f, name);
f->explicit_name = 1;
f->explicit_name = true;
/* use the frame's title when getting resources for this frame. */
specbind (Qx_resource_name, name);
}
@ -5103,7 +5096,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
f->output_data.x->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
x_figure_window_size (f, parms, 0);
x_figure_window_size (f, parms, false);
{
XSetWindowAttributes attrs;
@ -5156,7 +5149,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
height = FRAME_LINES (f);
SET_FRAME_COLS (f, 0);
SET_FRAME_LINES (f, 0);
change_frame_size (f, width, height, 1, 0, 0, 0);
change_frame_size (f, width, height, true, false, false, false);
/* Add `tooltip' frame parameter's default value. */
if (NILP (Fframe_parameter (frame, Qtooltip)))
@ -5209,7 +5202,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
}
}
f->no_split = 1;
f->no_split = true;
UNGCPRO;
@ -5327,7 +5320,8 @@ Text larger than the specified size is clipped. */)
int root_x, root_y;
struct buffer *old_buffer;
struct text_pos pos;
int i, width, height, seen_reversed_p;
int i, width, height;
bool seen_reversed_p;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
int old_windows_or_buffers_changed = windows_or_buffers_changed;
ptrdiff_t count = SPECPDL_INDEX ();
@ -5465,7 +5459,7 @@ Text larger than the specified size is clipped. */)
FRAME_TOTAL_COLS (f) = w->total_cols;
adjust_frame_glyphs (f);
w->pseudo_window_p = 1;
w->pseudo_window_p = true;
/* Display the tooltip text in a temporary buffer. */
old_buffer = current_buffer;
@ -5477,7 +5471,8 @@ Text larger than the specified size is clipped. */)
try_window (FRAME_ROOT_WINDOW (f), pos, TRY_WINDOW_IGNORE_FONTS_CHANGE);
/* Compute width and height of the tooltip. */
width = height = seen_reversed_p = 0;
width = height = 0;
seen_reversed_p = false;
for (i = 0; i < w->desired_matrix->nrows; ++i)
{
struct glyph_row *row = &w->desired_matrix->rows[i];
@ -5489,7 +5484,7 @@ Text larger than the specified size is clipped. */)
break;
/* Let the row go over the full width of the frame. */
row->full_width_p = 1;
row->full_width_p = true;
row_width = row->pixel_width;
if (row->used[TEXT_AREA])
@ -5512,7 +5507,7 @@ Text larger than the specified size is clipped. */)
if (g->type == STRETCH_GLYPH && NILP (g->object))
{
row_width -= g->pixel_width;
seen_reversed_p = 1;
seen_reversed_p = true;
}
}
}
@ -5548,7 +5543,7 @@ Text larger than the specified size is clipped. */)
if (!row->enabled_p || !MATRIX_ROW_DISPLAYS_TEXT_P (row))
break;
row->full_width_p = 1;
row->full_width_p = true;
row_width = row->pixel_width;
if (row->used[TEXT_AREA] && !row->reversed_p)
{
@ -5715,7 +5710,7 @@ clean_up_file_dialog (void *arg)
block_input ();
XtUnmanageChild (dialog);
XtDestroyWidget (dialog);
x_menu_set_in_use (0);
x_menu_set_in_use (false);
unblock_input ();
}
@ -5839,7 +5834,7 @@ value of DIR as in previous invocations; this is standard Windows behavior. */)
record_unwind_protect_ptr (clean_up_file_dialog, dialog);
/* Process events until the user presses Cancel or OK. */
x_menu_set_in_use (1);
x_menu_set_in_use (true);
result = 0;
while (result == 0)
{
@ -5893,7 +5888,7 @@ value of DIR as in previous invocations; this is standard Windows behavior. */)
static void
clean_up_dialog (void)
{
x_menu_set_in_use (0);
x_menu_set_in_use (false);
}
DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
@ -6192,7 +6187,7 @@ Changing the value does not affect existing frames
unless you set the mouse color. */);
Vx_pointer_shape = Qnil;
#if 0 /* This doesn't really do anything. */
#if false /* This doesn't really do anything. */
DEFVAR_LISP ("x-nontext-pointer-shape", Vx_nontext_pointer_shape,
doc: /* The shape of the pointer when not over text.
This variable takes effect when you create a new frame
@ -6206,7 +6201,7 @@ This variable takes effect when you create a new frame
or when you set the mouse color. */);
Vx_hourglass_pointer_shape = Qnil;
#if 0 /* This doesn't really do anything. */
#if false /* This doesn't really do anything. */
DEFVAR_LISP ("x-mode-pointer-shape", Vx_mode_pointer_shape,
doc: /* The shape of the pointer when over the mode line.
This variable takes effect when you create a new frame
@ -6268,25 +6263,25 @@ Chinese, Japanese, and Korean. */);
If nil or if the file selection dialog is not available, the new GTK file
chooser is used instead. To turn off all file dialogs set the
variable `use-file-dialog'. */);
x_gtk_use_old_file_dialog = 0;
x_gtk_use_old_file_dialog = false;
DEFVAR_BOOL ("x-gtk-show-hidden-files", x_gtk_show_hidden_files,
doc: /* If non-nil, the GTK file chooser will by default show hidden files.
Note that this is just the default, there is a toggle button on the file
chooser to show or not show hidden files on a case by case basis. */);
x_gtk_show_hidden_files = 0;
x_gtk_show_hidden_files = false;
DEFVAR_BOOL ("x-gtk-file-dialog-help-text", x_gtk_file_dialog_help_text,
doc: /* If non-nil, the GTK file chooser will show additional help text.
If more space for files in the file chooser dialog is wanted, set this to nil
to turn the additional text off. */);
x_gtk_file_dialog_help_text = 1;
x_gtk_file_dialog_help_text = true;
DEFVAR_BOOL ("x-gtk-use-system-tooltips", x_gtk_use_system_tooltips,
doc: /* If non-nil with a Gtk+ built Emacs, the Gtk+ tooltip is used.
Otherwise use Emacs own tooltip implementation.
When using Gtk+ tooltips, the tooltip face is not used. */);
x_gtk_use_system_tooltips = 1;
x_gtk_use_system_tooltips = true;
/* Tell Emacs about this window system. */
Fprovide (Qx, Qnil);
@ -6317,7 +6312,7 @@ When using Gtk+ tooltips, the tooltip face is not used. */);
char gtk_version[sizeof ".." + 3 * INT_STRLEN_BOUND (int)];
int len = sprintf (gtk_version, "%d.%d.%d",
GTK_MAJOR_VERSION, GTK_MINOR_VERSION, GTK_MICRO_VERSION);
Vgtk_version_string = make_pure_string (gtk_version, len, len, 0);
Vgtk_version_string = make_pure_string (gtk_version, len, len, false);
}
#endif /* USE_GTK */

6
src/xterm.h
View file

@ -1067,8 +1067,8 @@ extern void x_clipboard_manager_save_frame (Lisp_Object);
extern void x_clipboard_manager_save_all (void);
#ifdef USE_GTK
extern int xg_set_icon (struct frame *, Lisp_Object);
extern int xg_set_icon_from_xpm_data (struct frame *, const char **);
extern bool xg_set_icon (struct frame *, Lisp_Object);
extern bool xg_set_icon_from_xpm_data (struct frame *, const char **);
#endif /* USE_GTK */
extern void xic_free_xfontset (struct frame *);
@ -1081,7 +1081,7 @@ extern bool x_defined_color (struct frame *, const char *, XColor *, bool);
#ifdef HAVE_X_I18N
extern void free_frame_xic (struct frame *);
# if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
extern char * xic_create_fontsetname (const char *base_fontname, int motif);
extern char *xic_create_fontsetname (const char *, bool);
# endif
#endif

10
test/ChangeLog
View file

@ -1,3 +1,13 @@
2015-01-26 Stefan Monnier <monnier@iro.umontreal.ca>
* automated/cl-generic-tests.el: Try and make sure cl-lib is not
required at run-time.
2015-01-26 Stefan Monnier <monnier@iro.umontreal.ca>
* automated/cl-generic-tests.el (cl-generic-test-11-next-method-p):
New test.
2015-01-25 Paul Eggert <eggert@cs.ucla.edu>
* indent/shell.sh (bar): Use '[ $# -eq 0 ]', not '[ $# == 0 ]'.

12
test/automated/cl-generic-tests.el
View file

@ -23,8 +23,8 @@
;;; Code:
(require 'ert)
(require 'cl-lib)
(eval-when-compile (require 'ert)) ;Don't indirectly require cl-lib at run-time.
(require 'cl-generic)
(cl-defgeneric cl--generic-1 (x y))
(cl-defgeneric (setf cl--generic-1) (v y z) "My generic doc.")
@ -171,5 +171,13 @@
(should (equal (cl--generic-1 'a 'b) '(a b)))
(should (equal (cl--generic-1 1 2) '("integer" 2 1))))
(ert-deftest cl-generic-test-11-next-method-p ()
(cl-defgeneric cl--generic-1 (x y))
(cl-defmethod cl--generic-1 ((x t) y)
(list x y (cl-next-method-p)))
(cl-defmethod cl--generic-1 ((_x (eql 4)) _y)
(cl-list* "quatre" (cl-next-method-p) (cl-call-next-method)))
(should (equal (cl--generic-1 4 5) '("quatre" t 4 5 nil))))
(provide 'cl-generic-tests)
;;; cl-generic-tests.el ends here