diff options
author | Lars Magne Ingebrigtsen <larsi@gnus.org> | 2015-01-28 14:21:33 +1100 |
---|---|---|
committer | Lars Magne Ingebrigtsen <larsi@gnus.org> | 2015-01-28 14:21:33 +1100 |
commit | 7f4f16b3ae6fdb59d83cfc01017668f2a564309f (patch) | |
tree | 60e4a7f23f949afaed3bc2fddd0a528aef297861 | |
parent | 1a369fc7f1ccec6954344ec1ee0211a4d24c312d (diff) | |
parent | be2d23e58721b7acc68c0ea654a38e5109df2aa2 (diff) | |
download | emacs-7f4f16b3ae6fdb59d83cfc01017668f2a564309f.tar.gz |
Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs
43 files changed, 986 insertions, 543 deletions
diff --git a/ChangeLog b/ChangeLog index eecdad64785..68a734135ac 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,17 @@ +2015-01-27 Paul Eggert <eggert@cs.ucla.edu> + + Port autogen.sh hook creation to private templates + * autogen.sh: Do not assume that the hook samples exist. + This ports to developers who override templatedir in their Git + configuration. The downside is that patch applications won't be + checked, but that's better than autogen.sh failing. + Problem reported by Sam Steingold in: + http://lists.gnu.org/archive/html/emacs-devel/2015-01/msg00898.html + +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 diff --git a/INSTALL.REPO b/INSTALL.REPO index df997fbd285..3431ee480bf 100644 --- a/INSTALL.REPO +++ b/INSTALL.REPO @@ -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. diff --git a/autogen.sh b/autogen.sh index c3ae1d766df..bc9c5a008e0 100755 --- a/autogen.sh +++ b/autogen.sh @@ -226,6 +226,7 @@ if test -d .git/hooks; then tailored_hooks="$tailored_hooks $hook" done for hook in applypatch-msg pre-applypatch; do + test ! -r .git/hooks/$hook.sample || cmp .git/hooks/$hook.sample .git/hooks/$hook >/dev/null 2>&1 || sample_hooks="$sample_hooks $hook" done diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index a90c58725f8..b7853a7f118 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,3 +1,8 @@ +2015-01-27 Ivan Shmakov <ivan@siamics.net> + + * files.texi (File Archives): Document "I" for tar-new-entry. + (Bug#19274) + 2014-12-31 Paul Eggert <eggert@cs.ucla.edu> Less 'make' chatter for Emacs doc diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 196c6bb0092..b12b28f9c17 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1689,6 +1689,13 @@ likewise. @kbd{v} extracts a file into a buffer in View mode another window, so you could edit the file and operate on the archive simultaneously. + The @kbd{I} key adds a new (regular) file to the archive. The file +is initially empty, but can readily be edited using the commands +above. The command inserts the new file before the current one, so +that using it on the topmost line of the Tar buffer makes the new file +the first one in the archive, and using it at the end of the buffer +makes it the last one. + @kbd{d} marks a file for deletion when you later use @kbd{x}, and @kbd{u} unmarks a file, as in Dired. @kbd{C} copies a file from the archive to disk and @kbd{R} renames a file within the archive. diff --git a/etc/ChangeLog b/etc/ChangeLog index 71ecf7fad39..0677e441b83 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,11 @@ +2015-01-27 Ivan Shmakov <ivan@siamics.net> + + * NEWS: Mention the new tar-new-entry command. (Bug#19274) + +2015-01-27 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * NEWS: Document EUDC improvements. + 2015-01-26 Lars Ingebrigtsen <larsi@gnus.org> * publicsuffix.txt: Install an updated version of the file from @@ -495,6 +495,42 @@ As a result of the above, these commands are now obsolete: `find-tag-other-window', `find-tag-other-frame', `find-tag-regexp', `tags-apropos' and `tags-loop-continue'. +** EUDC +EUDC's LDAP backend has been improved. + +*** EUDC supports LDAP-over-SSL URLs (ldaps://). + +*** EUDC passes LDAP passwords through a pipe to the ldapsearch +subprocess instead of on the command line. + +*** EUDC handles LDAP wildcards automatically so the user shouldn't +need to configure this manually anymore. + +*** The LDAP configuration section of EUDC's manual has been +rewritten. + +There have also been customization changes. + +*** New custom variable `eudc-server-hotlist' to allow specifying +multiple EUDC servers in init file. + +*** Custom variable `eudc-inline-query-format' defaults to completing +on email and firstname instead of surname. + +*** Custom variable `eudc-expansion-overwrites-query' defaults to nil +to avoid interfering with the kill ring. + +*** Custom variable `eudc-inline-expansion-format' defaults to +"Firstname Surname <mail-address>". + +*** New custom variable `ldap-ldapsearch-password-prompt-regexp' to +allow overriding the regular expression that recognizes the ldapsearch +command line's password prompt. + ++++ +** tar-mode: new `tar-new-entry' command, allowing for new members to +be added to the archive. + ** Obsolete packages --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d17dff23a2f..b95424543f8 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,87 @@ +2015-01-27 Katsumi Yamaoka <yamaoka@jpl.org> + + * emacs-lisp/cl.el (cl--function-convert): + Merge cache that cl--labels-convert adds (bug#19699). + +2015-01-27 Ivan Shmakov <ivan@siamics.net> + + * tar-mode.el: Allow for adding new archive members. (Bug#19274) + (tar-new-regular-file-header, tar--pad-to, tar--put-at) + (tar-header-serialize): New functions. + (tar-current-position): Split from tar-current-descriptor. + (tar-current-descriptor): Use it. + (tar-new-entry): New command. + (tar-mode-map): Bind it. + +2015-01-27 Sam Steingold <sds@gnu.org> + + * progmodes/python.el (python-check-custom-command): Buffer local + because it usually includes the buffer name. + (python-check-command): Set to epylint when pyflakes is not available. + +2015-01-27 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/eudcb-bbdb.el, net/eudcb-ldap.el, net/eudcb-mab.el, + net/eudc-bob.el, net/eudcb-ph.el, net/eudc.el, net/eudc-export.el, + net/eudc-hotlist.el, net/eudc-vars.el: New maintainer. + +2015-01-27 Artur Malabarba <bruce.connor.am@gmail.com> + + * isearch.el (isearch-process-search-char): Add docstring. + +2015-01-27 Oleh Krehel <ohwoeowho@gmail.com> + + * emacs-lisp/derived.el (define-derived-mode): Declare indent 3. + +2015-01-27 Katsumi Yamaoka <yamaoka@jpl.org> + + * emacs-lisp/cl.el (cl--function-convert): Run cl--labels-convert + for the case cl-flet or cl-labels form is wrapped with lexical-let + (bug#19613). + +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. diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 02a43514019..1bb70963a57 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -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)))))))) - -(defconst cl--generic-nnm-sample (cl--generic-no-next-method-function 'dummy)) + (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)))) + +(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 `") diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index da3eab73fc4..1b204631fb8 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -342,6 +342,8 @@ The two cases that are handled are: - renaming of F when it's a function defined via `cl-labels' or `labels'." (require 'cl-macs) (declare-function cl--expr-contains-any "cl-macs" (x y)) + (declare-function cl--labels-convert "cl-macs" (f)) + (defvar cl--labels-convert-cache) (cond ;; ¡¡Big Ugly Hack!! We can't use a compiler-macro because those are checked ;; *after* handling `function', but we want to stop macroexpansion from @@ -374,13 +376,10 @@ The two cases that are handled are: (setq cl--function-convert-cache (cons newf res)) res)))) (t - (let ((found (assq f macroexpand-all-environment))) - (if (and found (ignore-errors - (eq (cadr (cl-caddr found)) 'cl-labels-args))) - (cadr (cl-caddr (cl-cadddr found))) - (let ((res `(function ,f))) - (setq cl--function-convert-cache (cons f res)) - res)))))) + (setq cl--labels-convert-cache cl--function-convert-cache) + (prog1 + (cl--labels-convert f) + (setq cl--function-convert-cache cl--labels-convert-cache))))) (defmacro lexical-let (bindings &rest body) "Like `let', but lexically scoped. diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index a250ea60d21..52da4c99eaf 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -162,7 +162,8 @@ The new mode runs the hook constructed by the function See Info node `(elisp)Derived Modes' for more details." (declare (debug (&define name symbolp sexp [&optional stringp] [&rest keywordp sexp] def-body)) - (doc-string 4)) + (doc-string 4) + (indent 3)) (when (and docstring (not (stringp docstring))) ;; Some trickiness, since what appears to be the docstring may really be diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el index c2dabf7f446..fcca99d79d5 100644 --- a/lisp/emacs-lisp/eieio-compat.el +++ b/lisp/emacs-lisp/eieio-compat.el @@ -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) diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 261138bfbf8..7492f0522ab 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -1258,7 +1258,7 @@ method invocation orders of the involved classes." (eieio--class-precedence-list tag)))) -;;;### (autoloads nil "eieio-compat" "eieio-compat.el" "57805f02023795a01567781e70aaf9f9") +;;;### (autoloads nil "eieio-compat" "eieio-compat.el" "b568ffb3c90ed5d0ae673f0051d608ee") ;;; Generated autoloads from eieio-compat.el (autoload 'eieio--defalias "eieio-compat" "\ diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el index 6534bd0fecf..119f7cce038 100644 --- a/lisp/emacs-lisp/eieio-datadebug.el +++ b/lisp/emacs-lisp/eieio-datadebug.el @@ -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 diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index a131b02ee16..8d40edf5624 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el @@ -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 diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 3dba8e0e7bf..91469b4b96c 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -942,7 +942,7 @@ Optional argument GROUP is the sub-group of slots to display. ;;;*** -;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "d7b8682e15aebad7dbe6384dc5ed655f") +;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "b849f8bf1312d5ef57e53d02173e4b5a") ;;; Generated autoloads from eieio-opt.el (autoload 'eieio-browse "eieio-opt" "\ diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 7ef526b4253..7bf4a6e01d6 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,23 @@ +2015-01-27 Lars Ingebrigtsen <larsi@gnus.org> + + * nnir.el (nnir-imap-expr-to-imap): Check for literal+ capability in + IMAP. + +2015-01-27 Eric Abrahamsen <eric@ericabrahamsen.net> + + * nnir.el (nnir-run-imap): Enable non-ASCII IMAP searches. + + * nnmairix.el ("nnmairix"): Declare nnmairix as virtual. + + * gnus-bcklg.el (gnus-backlog-enter-article): No virtual groups should + be added to the backlog. + +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. diff --git a/lisp/gnus/gnus-bcklg.el b/lisp/gnus/gnus-bcklg.el index b26f367a79b..e0c457a8829 100644 --- a/lisp/gnus/gnus-bcklg.el +++ b/lisp/gnus/gnus-bcklg.el @@ -61,7 +61,7 @@ (defun gnus-backlog-enter-article (group number buffer) (when (and (numberp number) - (not (string-match "^nnvirtual" group))) + (not (gnus-virtual-group-p group))) (gnus-backlog-setup) (let ((ident (intern (concat group ":" (int-to-string number)) gnus-backlog-hashtb)) @@ -126,7 +126,7 @@ (defun gnus-backlog-request-article (group number &optional buffer) (when (and (numberp number) - (not (string-match "^nnvirtual" group))) + (not (gnus-virtual-group-p group))) (gnus-backlog-setup) (let ((ident (intern (concat group ":" (int-to-string number)) gnus-backlog-hashtb)) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index ced55619881..8e81abcf9c0 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -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) diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 08ca7c7e06b..6d111e89e80 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -284,6 +284,8 @@ is `(valuefunc member)'." (eval-when-compile (autoload 'nnimap-buffer "nnimap") (autoload 'nnimap-command "nnimap") + (autoload 'nnimap-capability "nnimap") + (autoload 'nnimap-wait-for-line "nnimap") (autoload 'nnimap-change-group "nnimap") (autoload 'nnimap-make-thread-query "nnimap") (autoload 'gnus-registry-action "gnus-registry") @@ -968,33 +970,52 @@ details on the language and supported extensions." (catch 'found (mapcar #'(lambda (group) - (let (artlist) - (condition-case () - (when (nnimap-change-group - (gnus-group-short-name group) server) - (with-current-buffer (nnimap-buffer) - (message "Searching %s..." group) - (let ((arts 0) - (result (nnimap-command "UID SEARCH %s" - (if (string= criteria "") - qstring - (nnir-imap-make-query - criteria qstring))))) - (mapc - (lambda (artnum) - (let ((artn (string-to-number artnum))) - (when (> artn 0) - (push (vector group artn 100) - artlist) - (when (assq 'shortcut query) - (throw 'found (list artlist))) - (setq arts (1+ arts))))) - (and (car result) - (cdr (assoc "SEARCH" (cdr result))))) - (message "Searching %s... %d matches" group arts))) - (message "Searching %s...done" group)) - (quit nil)) - (nreverse artlist))) + (let (artlist) + (condition-case () + (when (nnimap-change-group + (gnus-group-short-name group) server) + (with-current-buffer (nnimap-buffer) + (message "Searching %s..." group) + (let* ((arts 0) + (literal+ (nnimap-capability "LITERAL+")) + (search (split-string + (if (string= criteria "") + qstring + (nnir-imap-make-query + criteria qstring)) + "\n")) + (coding (upcase + (replace-regexp-in-string + "-\\(unix\\|dos\\|mac\\)" "" + (symbol-name + (cdr default-process-coding-system))))) + call result) + (setq call (nnimap-send-command + "UID SEARCH CHARSET %s %s" coding (pop search))) + (while search ; Non-ascii search terms + (unless literal+ + (nnimap-wait-for-line "^\\+\\(.*\\)\n")) + (process-send-string (get-buffer-process (current-buffer)) (pop search)) + (process-send-string (get-buffer-process (current-buffer)) + (if (nnimap-newlinep nnimap-object) + "\n" + "\r\n"))) + (setq result (nnimap-get-response call)) + (mapc + (lambda (artnum) + (let ((artn (string-to-number artnum))) + (when (> artn 0) + (push (vector group artn 100) + artlist) + (when (assq 'shortcut query) + (throw 'found (list artlist))) + (setq arts (1+ arts))))) + (and (car result) + (cdr (assoc "SEARCH" (cdr result))))) + (message "Searching %s... %d matches" group arts))) + (message "Searching %s...done" group)) + (quit nil)) + (nreverse artlist))) groups)))))) (defun nnir-imap-make-query (criteria qstring) @@ -1048,25 +1069,30 @@ In future the following will be added to the language: (defun nnir-imap-expr-to-imap (criteria expr) "Convert EXPR into an IMAP search expression on CRITERIA" ;; What sort of expression is this, eh? - (cond - ;; Simple string term - ((stringp expr) - (format "%s %S" criteria expr)) - ;; Trivial term: and - ((eq expr 'and) nil) - ;; Composite term: or expression - ((eq (car-safe expr) 'or) - (format "OR %s %s" - (nnir-imap-expr-to-imap criteria (second expr)) - (nnir-imap-expr-to-imap criteria (third expr)))) - ;; Composite term: just the fax, mam - ((eq (car-safe expr) 'not) - (format "NOT (%s)" (nnir-imap-query-to-imap criteria (rest expr)))) - ;; Composite term: just expand it all. - ((and (not (null expr)) (listp expr)) - (format "(%s)" (nnir-imap-query-to-imap criteria expr))) - ;; Complex value, give up for now. - (t (error "Unhandled input: %S" expr)))) + (let ((literal+ (nnimap-capability "LITERAL+"))) + (cond + ;; Simple string term + ((stringp expr) + (format "%s %S" criteria expr)) + ;; Trivial term: and + ((eq expr 'and) nil) + ;; Composite term: or expression + ((eq (car-safe expr) 'or) + (format "OR %s %s" + (nnir-imap-expr-to-imap criteria (second expr)) + (nnir-imap-expr-to-imap criteria (third expr)))) + ;; Composite term: just the fax, mam + ((eq (car-safe expr) 'not) + (format "NOT (%s)" (nnir-imap-query-to-imap criteria (rest expr)))) + ;; Composite term: non-ascii search term + ((numberp (car-safe expr)) + (format "%s {%d%s}\n%s" criteria (car expr) + (if literal+ "+" "") (second expr))) + ;; Composite term: just expand it all. + ((and (not (null expr)) (listp expr)) + (format "(%s)" (nnir-imap-query-to-imap criteria expr))) + ;; Complex value, give up for now. + (t (error "Unhandled input: %S" expr))))) (defun nnir-imap-parse-query (string) @@ -1108,6 +1134,11 @@ that the search language can then understand and use." ((eq term 'and) 'and) ;; negated term ((eq term 'not) (list 'not (nnir-imap-next-expr))) + ;; non-ascii search string + ((and (stringp term) + (not (= (string-bytes term) + (length term)))) + (list (string-bytes term) term)) ;; generic term (t term)))) diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el index 5a01ce8c25c..96b40e5b845 100644 --- a/lisp/gnus/nnmairix.el +++ b/lisp/gnus/nnmairix.el @@ -417,7 +417,7 @@ Other back ends might or might not work.") (nnoo-define-basics nnmairix) -(gnus-declare-backend "nnmairix" 'mail 'address) +(gnus-declare-backend "nnmairix" 'mail 'address 'virtual) (deffoo nnmairix-open-server (server &optional definitions) ;; just set server variables diff --git a/lisp/isearch.el b/lisp/isearch.el index 191ec8270eb..99ca73f9f54 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2349,6 +2349,8 @@ With argument, add COUNT copies of the character." (isearch-process-search-char char count)))) (defun isearch-process-search-char (char &optional count) + "Add CHAR to the search string, COUNT times. +Search is updated accordingly." ;; * and ? are special in regexps when not preceded by \. ;; } and | are special in regexps when preceded by \. ;; Nothing special for + because it matches at least once. diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el index 622ea72d021..f01f671de9e 100644 --- a/lisp/net/eudc-bob.el +++ b/lisp/net/eudc-bob.el @@ -3,7 +3,8 @@ ;; Copyright (C) 1999-2015 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> -;; Maintainer: Pavel JanÃk <Pavel@Janik.cz> +;; Pavel JanÃk <Pavel@Janik.cz> +;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org> ;; Keywords: comm ;; Package: eudc diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el index bbdb294da7f..0e54d841d57 100644 --- a/lisp/net/eudc-export.el +++ b/lisp/net/eudc-export.el @@ -3,7 +3,8 @@ ;; Copyright (C) 1998-2015 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> -;; Maintainer: Pavel JanÃk <Pavel@Janik.cz> +;; Pavel JanÃk <Pavel@Janik.cz> +;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org> ;; Keywords: comm ;; Package: eudc diff --git a/lisp/net/eudc-hotlist.el b/lisp/net/eudc-hotlist.el index b3c9a6db0d5..7416ad090eb 100644 --- a/lisp/net/eudc-hotlist.el +++ b/lisp/net/eudc-hotlist.el @@ -3,7 +3,8 @@ ;; Copyright (C) 1998-2015 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> -;; Maintainer: Pavel JanÃk <Pavel@Janik.cz> +;; Pavel JanÃk <Pavel@Janik.cz> +;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org> ;; Keywords: comm ;; Package: eudc diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el index 29ddf613376..36a583daa4d 100644 --- a/lisp/net/eudc-vars.el +++ b/lisp/net/eudc-vars.el @@ -3,7 +3,8 @@ ;; Copyright (C) 1998-2015 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> -;; Maintainer: Pavel JanÃk <Pavel@Janik.cz> +;; Pavel JanÃk <Pavel@Janik.cz> +;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org> ;; Keywords: comm ;; Package: eudc diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 4dd80972e3f..cf5d13fce88 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -3,7 +3,8 @@ ;; Copyright (C) 1998-2015 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> -;; Maintainer: Pavel JanÃk <Pavel@Janik.cz> +;; Pavel JanÃk <Pavel@Janik.cz> +;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org> ;; Keywords: comm ;; This file is part of GNU Emacs. diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el index 0400e5b5bb4..5be2bec0c5d 100644 --- a/lisp/net/eudcb-bbdb.el +++ b/lisp/net/eudcb-bbdb.el @@ -3,7 +3,8 @@ ;; Copyright (C) 1998-2015 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> -;; Maintainer: Pavel JanÃk <Pavel@Janik.cz> +;; Pavel JanÃk <Pavel@Janik.cz> +;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org> ;; Keywords: comm ;; Package: eudc diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el index 92972c5f99e..1d426a7b7b0 100644 --- a/lisp/net/eudcb-ldap.el +++ b/lisp/net/eudcb-ldap.el @@ -3,7 +3,8 @@ ;; Copyright (C) 1998-2015 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> -;; Maintainer: Pavel JanÃk <Pavel@Janik.cz> +;; Pavel JanÃk <Pavel@Janik.cz> +;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org> ;; Keywords: comm ;; Package: eudc diff --git a/lisp/net/eudcb-mab.el b/lisp/net/eudcb-mab.el index 81d8f24ecb2..a11cd95b05d 100644 --- a/lisp/net/eudcb-mab.el +++ b/lisp/net/eudcb-mab.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2003-2015 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw@newartisans.com> -;; Maintainer: emacs-devel@gnu.org +;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org> ;; Keywords: comm ;; Package: eudc diff --git a/lisp/net/eudcb-ph.el b/lisp/net/eudcb-ph.el index fc6aad671c0..1897e0b08bc 100644 --- a/lisp/net/eudcb-ph.el +++ b/lisp/net/eudcb-ph.el @@ -3,7 +3,8 @@ ;; Copyright (C) 1998-2015 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> -;; Maintainer: Pavel JanÃk <Pavel@Janik.cz> +;; Pavel JanÃk <Pavel@Janik.cz> +;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org> ;; Keywords: comm ;; Package: eudc diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index d298f96bc81..13ff439bef2 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -3816,7 +3816,9 @@ The skeleton will be bound to python-skeleton-NAME." ;;; Code check (defcustom python-check-command - "pyflakes" + (or (executable-find "pyflakes") + (executable-find "epylint") + "install pyflakes, pylint or something else") "Command used to check a Python file." :type 'string :group 'python) @@ -3827,7 +3829,7 @@ The skeleton will be bound to python-skeleton-NAME." :type 'string :group 'python) -(defvar python-check-custom-command nil +(defvar-local python-check-custom-command nil "Internal use.") (defun python-check (command) diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 1ee54515bea..6c7f7553f82 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -50,9 +50,6 @@ ;; ;; o chmod should understand "a+x,og-w". ;; -;; o It's not possible to add a NEW file to a tar archive; not that -;; important, but still... -;; ;; o The code is less efficient that it could be - in a lot of places, I ;; pull a 512-character string out of the buffer and parse it, when I could ;; be parsing it in place, not garbaging a string. Should redo that. @@ -369,6 +366,80 @@ write-date, checksum, link-type, and link-name." string) (tar-parse-octal-integer string)) +(defun tar-new-regular-file-header (filename &optional size time) + "Return a Tar header for a regular file. +The header will lack a proper checksum; use `tar-header-block-checksum' +to compute one, or request `tar-header-serialize' to do that. + +Other tar-mode facilities may also require the data-start header +field to be set to a valid value. + +If SIZE is not given or nil, it defaults to 0. +If TIME is not given or nil, assume now." + (make-tar-header + nil + filename + #o644 0 0 (or size 0) + (or time (current-time)) + nil ; checksum + nil nil + nil nil nil nil nil)) + +(defun tar--pad-to (pos) + (make-string (+ pos (- (point)) (point-min)) 0)) + +(defun tar--put-at (pos val &optional fmt mask) + (when val + (insert (tar--pad-to pos) + (if fmt + (format fmt (if mask (logand mask val) val)) + val)))) + +(defun tar-header-serialize (header &optional update-checksum) + "Return the serialization of a Tar HEADER as a string. +This function calls `tar-header-block-check-checksum' to ensure the +checksum is correct. + +If UPDATE-CHECKSUM is non-nil, update HEADER with the newly-computed +checksum before doing the check." + (with-temp-buffer + (set-buffer-multibyte nil) + (let ((encoded-name + (encode-coding-string (tar-header-name header) + tar-file-name-coding-system))) + (unless (< (length encoded-name) 99) + ;; FIXME: Implement it. + (error "Long file name support is not implemented")) + (insert encoded-name)) + (tar--put-at tar-mode-offset (tar-header-mode header) "%6o\0 " #o777777) + (tar--put-at tar-uid-offset (tar-header-uid header) "%6o\0 " #o777777) + (tar--put-at tar-gid-offset (tar-header-gid header) "%6o\0 " #o777777) + (tar--put-at tar-size-offset (tar-header-size header) "%11o ") + (insert (tar--pad-to tar-time-offset) + (tar-octal-time (tar-header-date header)) + " ") + ;; Omit tar-header-checksum (tar-chk-offset) for now. + (tar--put-at tar-linkp-offset (tar-header-link-type header)) + (tar--put-at tar-link-offset (tar-header-link-name header)) + (when (tar-header-magic header) + (tar--put-at tar-magic-offset (tar-header-magic header)) + (tar--put-at tar-uname-offset (tar-header-uname header)) + (tar--put-at tar-gname-offset (tar-header-gname header)) + (tar--put-at tar-dmaj-offset (tar-header-dmaj header) "%7o\0" #o7777777) + (tar--put-at tar-dmin-offset (tar-header-dmin header) "%7o\0" #o7777777)) + (tar--put-at 512 "") + (let ((ck (tar-header-block-checksum (buffer-string)))) + (goto-char (+ (point-min) tar-chk-offset)) + (delete-char 8) + (insert (format "%6o\0 " ck)) + (when update-checksum + (setf (tar-header-checksum header) ck)) + (tar-header-block-check-checksum (buffer-string) + (tar-header-checksum header) + (tar-header-name header))) + ;; . + (buffer-string))) + (defun tar-header-block-checksum (string) "Compute and return a tar-acceptable checksum for this block." @@ -547,6 +618,7 @@ MODE should be an integer which is a file mode value." (define-key map "p" 'tar-previous-line) (define-key map "\^P" 'tar-previous-line) (define-key map [up] 'tar-previous-line) + (define-key map "I" 'tar-new-entry) (define-key map "R" 'tar-rename-entry) (define-key map "u" 'tar-unflag) (define-key map "v" 'tar-view) @@ -731,10 +803,14 @@ tar-file's buffer." (interactive "p") (tar-next-line (- arg))) +(defun tar-current-position () + "Return the `tar-parse-info' index for the current line." + (count-lines (point-min) (line-beginning-position))) + (defun tar-current-descriptor (&optional noerror) "Return the tar-descriptor of the current line, or signals an error." ;; I wish lines had plists, like in ZMACS... - (or (nth (count-lines (point-min) (line-beginning-position)) + (or (nth (tar-current-position) tar-parse-info) (if noerror nil @@ -948,6 +1024,37 @@ the current tar-entry." (write-region start end to-file nil nil nil t))) (message "Copied tar entry %s to %s" name to-file))) +(defun tar-new-entry (filename &optional index) + "Insert a new empty regular file before point." + (interactive "*sFile name: ") + (let* ((buffer (current-buffer)) + (index (or index (tar-current-position))) + (d-list (and (not (zerop index)) + (nthcdr (+ -1 index) tar-parse-info))) + (pos (if d-list + (tar-header-data-end (car d-list)) + (point-min))) + (new-descriptor + (tar-new-regular-file-header filename))) + ;; Update the data buffer; fill the missing descriptor fields. + (with-current-buffer tar-data-buffer + (goto-char pos) + (insert (tar-header-serialize new-descriptor t)) + (setf (tar-header-data-start new-descriptor) + (copy-marker (point) nil))) + ;; Update tar-parse-info. + (if d-list + (setcdr d-list (cons new-descriptor (cdr d-list))) + (setq tar-parse-info (cons new-descriptor tar-parse-info))) + ;; Update the listing buffer. + (save-excursion + (goto-char (point-min)) + (forward-line index) + (let ((inhibit-read-only t)) + (insert (tar-header-block-summarize new-descriptor) ?\n))) + ;; . + index)) + (defun tar-flag-deleted (p &optional unflag) "In Tar mode, mark this sub-file to be deleted from the tar file. With a prefix argument, mark that many files." diff --git a/src/ChangeLog b/src/ChangeLog index 4fc0de7c815..8e5166e22be 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,56 @@ +2015-01-27 Paul Eggert <eggert@cs.ucla.edu> + + Use bool for boolean in xfaces.c + * dispextern.h: Adjust to signature changes. + * font.c (font_at, font_range): + * fontset.c (Finternal_char_font): + * fringe.c (draw_fringe_bitmap_1): + * xdisp.c (handle_face_prop, face_before_or_after_it_pos) + (get_next_display_element, highlight_trailing_whitespace) + (display_string, calc_line_height_property) + (note_mode_line_or_margin_highlight, note_mouse_highlight): + * xfaces.c (tty_suppress_bold_inverse_default_colors_p) + (menu_face_changed_default, recompute_basic_faces) + (Fbitmap_spec_p, parse_rgb_list, tty_lookup_color) + (tty_defined_color, defined_color, face_color_gray_p) + (face_color_supported_p, load_color2, load_face_colors) + (Fx_list_fonts, LFACEP, push_named_merge_point) + (resolve_face_name, lface_from_face_name_no_resolve) + (lface_from_face_name, get_lface_attributes_no_remap) + (get_lface_attributes, lface_fully_specified_p) + (set_lface_from_font, merge_face_vectors, merge_named_face) + (merge_face_ref, Finternal_make_lisp_face) + (Finternal_lisp_face_p, Finternal_copy_lisp_face) + (Finternal_set_lisp_face_attribute) + (update_face_from_frame_parameter, set_font_frame_param) + (face_boolean_x_resource_value) + (Finternal_set_lisp_face_attribute_from_resource) + (x_update_menu_appearance, Finternal_get_lisp_face_attribute) + (Finternal_merge_in_global_face, Fface_font, face_attr_equal_p) + (lface_equal_p, Finternal_lisp_face_equal_p) + (Finternal_lisp_face_empty_p, lface_same_font_attributes_p) + (Fcolor_distance, lookup_named_face, lookup_basic_face) + (lookup_derived_face, Fface_attributes_as_vector) + (x_supports_face_attributes_p, tty_supports_face_attributes_p) + (Fdisplay_supports_face_attributes_p, realize_basic_faces) + (realize_default_face, realize_named_face) + (realize_non_ascii_face, realize_x_face, map_tty_color) + (realize_tty_face, compute_char_face, face_at_buffer_position) + (face_for_overlay_string, face_at_string_position): + Use bool for boolean. + * xfaces.c (set_lface_from_font): + Return void, since callers never use the result. + +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 diff --git a/src/dispextern.h b/src/dispextern.h index e9e6f709079..31e7262d6ec 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -3380,23 +3380,20 @@ char *choose_face_font (struct frame *, Lisp_Object *, Lisp_Object, #ifdef HAVE_WINDOW_SYSTEM void prepare_face_for_display (struct frame *, struct face *); #endif -int lookup_named_face (struct frame *, Lisp_Object, int); +int lookup_named_face (struct frame *, Lisp_Object, bool); int lookup_basic_face (struct frame *, int); int smaller_face (struct frame *, int, int); int face_with_height (struct frame *, int, int); -int lookup_derived_face (struct frame *, Lisp_Object, int, int); +int lookup_derived_face (struct frame *, Lisp_Object, int, bool); void init_frame_faces (struct frame *); void free_frame_faces (struct frame *); void recompute_basic_faces (struct frame *); -int face_at_buffer_position (struct window *w, ptrdiff_t pos, - ptrdiff_t *endptr, ptrdiff_t limit, - int mouse, int base_face_id); -int face_for_overlay_string (struct window *w, ptrdiff_t pos, - ptrdiff_t *endptr, ptrdiff_t limit, - int mouse, Lisp_Object overlay); -int face_at_string_position (struct window *w, Lisp_Object string, - ptrdiff_t pos, ptrdiff_t bufpos, - ptrdiff_t *endptr, enum face_id, int mouse); +int face_at_buffer_position (struct window *, ptrdiff_t, ptrdiff_t *, ptrdiff_t, + bool, int); +int face_for_overlay_string (struct window *, ptrdiff_t, ptrdiff_t *, ptrdiff_t, + bool, Lisp_Object); +int face_at_string_position (struct window *, Lisp_Object, ptrdiff_t, ptrdiff_t, + ptrdiff_t *, enum face_id, bool); int merge_faces (struct frame *, Lisp_Object, int, int); int compute_char_face (struct frame *, int, Lisp_Object); void free_all_realized_faces (Lisp_Object); diff --git a/src/font.c b/src/font.c index d1a008e794d..9ea43cdfc85 100644 --- a/src/font.c +++ b/src/font.c @@ -3707,10 +3707,10 @@ font_at (int c, ptrdiff_t pos, struct face *face, struct window *w, if (STRINGP (string)) face_id = face_at_string_position (w, string, pos, 0, &endptr, - DEFAULT_FACE_ID, 0); + DEFAULT_FACE_ID, false); else face_id = face_at_buffer_position (w, pos, &endptr, - pos + 100, 0, -1); + pos + 100, false, -1); face = FACE_FROM_ID (f, face_id); } if (multibyte) @@ -3754,7 +3754,7 @@ font_range (ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t *limit, int face_id; face_id = face_at_buffer_position (w, pos, &ignore, - *limit, 0, -1); + *limit, false, -1); face = FACE_FROM_ID (XFRAME (w->frame), face_id); } } diff --git a/src/fontset.c b/src/fontset.c index 357526bacfe..c0303fa5a34 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -1828,7 +1828,7 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0, w = XWINDOW (window); f = XFRAME (w->frame); face_id = face_at_buffer_position (w, pos, &dummy, - pos + 100, 0, -1); + pos + 100, false, -1); } if (! CHAR_VALID_P (c)) return Qnil; diff --git a/src/fringe.c b/src/fringe.c index 464379d0cd0..5e5ec60a48f 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -587,7 +587,7 @@ draw_fringe_bitmap_1 (struct window *w, struct glyph_row *row, int left_p, int o if (face_id == DEFAULT_FACE_ID) { Lisp_Object face = fringe_faces[which]; - face_id = NILP (face) ? lookup_named_face (f, Qfringe, 0) + face_id = NILP (face) ? lookup_named_face (f, Qfringe, false) : lookup_derived_face (f, face, FRINGE_FACE_ID, 0); if (face_id < 0) face_id = FRINGE_FACE_ID; diff --git a/src/image.c b/src/image.c index 9c09c5596b9..df299bbd164 100644 --- a/src/image.c +++ b/src/image.c @@ -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)) { diff --git a/src/xdisp.c b/src/xdisp.c index d974687a431..71871ec5885 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3877,7 +3877,7 @@ handle_face_prop (struct it *it) &next_stop, (IT_CHARPOS (*it) + TEXT_PROP_DISTANCE_LIMIT), - 0, it->base_face_id); + false, it->base_face_id); /* Is this a start of a run of characters with box face? Caveat: this can be called for a freshly initialized @@ -3953,7 +3953,7 @@ handle_face_prop (struct it *it) &next_stop, (IT_CHARPOS (*it) + TEXT_PROP_DISTANCE_LIMIT), - 0, + false, from_overlay); } else @@ -3988,7 +3988,7 @@ handle_face_prop (struct it *it) IT_STRING_CHARPOS (*it), bufpos, &next_stop, - base_face_id, 0); + base_face_id, false); /* Is this a start of a run of characters with box? Caveat: this can be called for a freshly allocated iterator; face_id @@ -4130,7 +4130,7 @@ face_before_or_after_it_pos (struct it *it, int before_p) charpos, bufpos, &next_check_charpos, - base_face_id, 0); + base_face_id, false); /* Correct the face for charsets different from ASCII. Do it for the multibyte case only. The face returned above is @@ -4219,7 +4219,7 @@ face_before_or_after_it_pos (struct it *it, int before_p) face_id = face_at_buffer_position (it->w, CHARPOS (pos), &next_check_charpos, - limit, 0, -1); + limit, false, -1); /* Correct the face for charsets different from ASCII. Do it for the multibyte case only. The face returned above is @@ -7165,7 +7165,7 @@ get_next_display_element (struct it *it) { next_face_id = face_at_buffer_position (it->w, CHARPOS (pos), &ignore, - CHARPOS (pos) + TEXT_PROP_DISTANCE_LIMIT, 0, -1); + CHARPOS (pos) + TEXT_PROP_DISTANCE_LIMIT, false, -1); it->end_of_box_run_p = (FACE_FROM_ID (it->f, next_face_id)->box == FACE_NO_BOX); @@ -19551,7 +19551,7 @@ highlight_trailing_whitespace (struct frame *f, struct glyph_row *row) && glyph->u.ch == ' ')) && trailing_whitespace_p (glyph->charpos)) { - int face_id = lookup_named_face (f, Qtrailing_whitespace, 0); + int face_id = lookup_named_face (f, Qtrailing_whitespace, false); if (face_id < 0) return; @@ -23561,7 +23561,7 @@ display_string (const char *string, Lisp_Object lisp_string, Lisp_Object face_st it->face_id = face_at_string_position (it->w, face_string, face_string_pos, - 0, &endptr, it->base_face_id, 0); + 0, &endptr, it->base_face_id, false); face = FACE_FROM_ID (it->f, it->face_id); it->face_box_p = face->box != FACE_NO_BOX; } @@ -26067,7 +26067,7 @@ calc_line_height_property (struct it *it, Lisp_Object val, struct font *font, int face_id; struct face *face; - face_id = lookup_named_face (it->f, face_name, 0); + face_id = lookup_named_face (it->f, face_name, false); if (face_id < 0) return make_number (-1); @@ -29283,7 +29283,7 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, charpos, 0, &ignore, glyph->face_id, - 1); + true); show_mouse_face (hlinfo, DRAW_MOUSE_FACE); if (NILP (pointer)) @@ -29611,7 +29611,7 @@ note_mouse_highlight (struct frame *f, int x, int y) hlinfo->mouse_face_window = window; hlinfo->mouse_face_face_id = face_at_string_position (w, object, pos, 0, &ignore, - glyph->face_id, 1); + glyph->face_id, true); show_mouse_face (hlinfo, DRAW_MOUSE_FACE); cursor = No_Cursor; } diff --git a/src/xfaces.c b/src/xfaces.c index 31048aece5d..7c9f62683fd 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -265,11 +265,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include <c-ctype.h> -/* Non-zero if face attribute ATTR is unspecified. */ +/* True if face attribute ATTR is unspecified. */ #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified) -/* Non-zero if face attribute ATTR is `ignore-defface'. */ +/* True if face attribute ATTR is `ignore-defface'. */ #define IGNORE_DEFFACE_P(ATTR) EQ ((ATTR), QCignore_defface) @@ -318,12 +318,12 @@ static int clear_font_table_count; int face_change_count; -/* Non-zero means don't display bold text if a face's foreground +/* True means don't display bold text if a face's foreground and background colors are the inverse of the default colors of the display. This is a kluge to suppress `bold black' foreground text which is hard to read on an LCD monitor. */ -static int tty_suppress_bold_inverse_default_colors_p; +static bool tty_suppress_bold_inverse_default_colors_p; /* A list of the form `((x . y))' used to avoid consing in Finternal_set_lisp_face_attribute. */ @@ -338,10 +338,10 @@ static int npixmaps_allocated; static int ngcs; #endif -/* Non-zero means the definition of the `menu' face for new frames has +/* True means the definition of the `menu' face for new frames has been changed. */ -static int menu_face_changed_default; +static bool menu_face_changed_default; struct named_merge_point; @@ -354,8 +354,8 @@ static bool realize_default_face (struct frame *); static void realize_named_face (struct frame *, Lisp_Object, int); static struct face_cache *make_face_cache (struct frame *); static void free_face_cache (struct face_cache *); -static int merge_face_ref (struct frame *, Lisp_Object, Lisp_Object *, - int, struct named_merge_point *); +static bool merge_face_ref (struct frame *, Lisp_Object, Lisp_Object *, + bool, struct named_merge_point *); static int color_distance (XColor *x, XColor *y); #ifdef HAVE_WINDOW_SYSTEM @@ -638,14 +638,14 @@ recompute_basic_faces (struct frame *f) { if (FRAME_FACE_CACHE (f)) { - clear_face_cache (0); + clear_face_cache (false); if (!realize_basic_faces (f)) emacs_abort (); } } -/* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means +/* Clear the face caches of all frames. CLEAR_FONTS_P means try to free unused fonts, too. */ void @@ -715,11 +715,11 @@ the pixmap. Bits are stored row by row, each row occupies \(WIDTH + 7)/8 bytes. */) (Lisp_Object object) { - bool pixmap_p = 0; + bool pixmap_p = false; if (STRINGP (object)) /* If OBJECT is a string, it's a file name. */ - pixmap_p = 1; + pixmap_p = true; else if (CONSP (object)) { /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and @@ -749,7 +749,7 @@ the pixmap. Bits are stored row by row, each row occupies int bytes_per_row = ((XINT (width) + BITS_PER_CHAR - 1) / BITS_PER_CHAR); if (XINT (height) <= SBYTES (data) / bytes_per_row) - pixmap_p = 1; + pixmap_p = true; } } @@ -820,9 +820,9 @@ load_pixmap (struct frame *f, Lisp_Object name) /* Parse RGB_LIST, and fill in the RGB fields of COLOR. RGB_LIST should contain (at least) 3 lisp integers. - Return 0 if there's a problem with RGB_LIST, otherwise return 1. */ + Return true iff RGB_LIST is OK. */ -static int +static bool parse_rgb_list (Lisp_Object rgb_list, XColor *color) { #define PARSE_RGB_LIST_FIELD(field) \ @@ -832,13 +832,13 @@ parse_rgb_list (Lisp_Object rgb_list, XColor *color) rgb_list = XCDR (rgb_list); \ } \ else \ - return 0; + return false; PARSE_RGB_LIST_FIELD (red); PARSE_RGB_LIST_FIELD (green); PARSE_RGB_LIST_FIELD (blue); - return 1; + return true; } @@ -854,7 +854,7 @@ tty_lookup_color (struct frame *f, Lisp_Object color, XColor *tty_color, Lisp_Object frame, color_desc; if (!STRINGP (color) || NILP (Ffboundp (Qtty_color_desc))) - return 0; + return false; XSETFRAME (frame, f); @@ -864,13 +864,13 @@ tty_lookup_color (struct frame *f, Lisp_Object color, XColor *tty_color, Lisp_Object rgb; if (! INTEGERP (XCAR (XCDR (color_desc)))) - return 0; + return false; tty_color->pixel = XINT (XCAR (XCDR (color_desc))); rgb = XCDR (XCDR (color_desc)); if (! parse_rgb_list (rgb, tty_color)) - return 0; + return false; /* Should we fill in STD_COLOR too? */ if (std_color) @@ -889,21 +889,21 @@ tty_lookup_color (struct frame *f, Lisp_Object color, XColor *tty_color, /* Look up STD_COLOR separately. */ rgb = call1 (Qtty_color_standard_values, color); if (! parse_rgb_list (rgb, std_color)) - return 0; + return false; } } - return 1; + return true; } else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist")))) /* We were called early during startup, and the colors are not yet set up in tty-defined-color-alist. Don't return a failure indication, since this produces the annoying "Unable to load color" messages in the *Messages* buffer. */ - return 1; + return true; else /* tty-color-desc seems to have returned a bad value. */ - return 0; + return false; } /* A version of defined_color for non-X frames. */ @@ -912,7 +912,7 @@ static bool tty_defined_color (struct frame *f, const char *color_name, XColor *color_def, bool alloc) { - bool status = 1; + bool status = true; /* Defaults. */ color_def->pixel = FACE_TTY_DEFAULT_COLOR; @@ -932,7 +932,7 @@ tty_defined_color (struct frame *f, const char *color_name, } if (color_def->pixel != FACE_TTY_DEFAULT_COLOR) - status = 1; + status = true; return status; } @@ -960,7 +960,7 @@ defined_color (struct frame *f, const char *color_name, XColor *color_def, #endif #ifdef HAVE_NS else if (FRAME_NS_P (f)) - return ns_defined_color (f, color_name, color_def, alloc, 1); + return ns_defined_color (f, color_name, color_def, alloc, true); #endif else emacs_abort (); @@ -1000,18 +1000,18 @@ tty_color_name (struct frame *f, int idx) } -/* Return non-zero if COLOR_NAME is a shade of gray (or white or +/* Return true if COLOR_NAME is a shade of gray (or white or black) on frame F. The criterion implemented here is not a terribly sophisticated one. */ -static int +static bool face_color_gray_p (struct frame *f, const char *color_name) { XColor color; - int gray_p; + bool gray_p; - if (defined_color (f, color_name, &color, 0)) + if (defined_color (f, color_name, &color, false)) gray_p = (/* Any color sufficiently close to black counts as gray. */ (color.red < 5000 && color.green < 5000 && color.blue < 5000) || @@ -1022,19 +1022,18 @@ face_color_gray_p (struct frame *f, const char *color_name) && (eabs (color.blue - color.red) < max (color.blue, color.red) / 20))); else - gray_p = 0; + gray_p = false; return gray_p; } -/* Return non-zero if color COLOR_NAME can be displayed on frame F. - BACKGROUND_P non-zero means the color will be used as background - color. */ +/* Return true if color COLOR_NAME can be displayed on frame F. + BACKGROUND_P means the color will be used as background color. */ -static int +static bool face_color_supported_p (struct frame *f, const char *color_name, - int background_p) + bool background_p) { Lisp_Object frame; XColor not_used; @@ -1052,7 +1051,7 @@ face_color_supported_p (struct frame *f, const char *color_name, && face_color_gray_p (f, color_name))) : #endif - tty_defined_color (f, color_name, ¬_used, 0); + tty_defined_color (f, color_name, ¬_used, false); } @@ -1098,39 +1097,39 @@ load_color2 (struct frame *f, struct face *face, Lisp_Object name, /* if the color map is full, defined_color will return a best match to the values in an existing cell. */ - if (!defined_color (f, SSDATA (name), color, 1)) + if (!defined_color (f, SSDATA (name), color, true)) { add_to_log ("Unable to load color \"%s\"", name, Qnil); switch (target_index) { case LFACE_FOREGROUND_INDEX: - face->foreground_defaulted_p = 1; + face->foreground_defaulted_p = true; color->pixel = FRAME_FOREGROUND_PIXEL (f); break; case LFACE_BACKGROUND_INDEX: - face->background_defaulted_p = 1; + face->background_defaulted_p = true; color->pixel = FRAME_BACKGROUND_PIXEL (f); break; case LFACE_UNDERLINE_INDEX: - face->underline_defaulted_p = 1; + face->underline_defaulted_p = true; color->pixel = FRAME_FOREGROUND_PIXEL (f); break; case LFACE_OVERLINE_INDEX: - face->overline_color_defaulted_p = 1; + face->overline_color_defaulted_p = true; color->pixel = FRAME_FOREGROUND_PIXEL (f); break; case LFACE_STRIKE_THROUGH_INDEX: - face->strike_through_color_defaulted_p = 1; + face->strike_through_color_defaulted_p = true; color->pixel = FRAME_FOREGROUND_PIXEL (f); break; case LFACE_BOX_INDEX: - face->box_color_defaulted_p = 1; + face->box_color_defaulted_p = true; color->pixel = FRAME_FOREGROUND_PIXEL (f); break; @@ -1196,7 +1195,7 @@ load_face_colors (struct frame *f, struct face *face, face_color_supported_p is smart enough to know that grays are "supported" as background because we are supposed to use stipple for them. */ - if (!face_color_supported_p (f, SSDATA (bg), 0) + if (!face_color_supported_p (f, SSDATA (bg), false) && !NILP (Fbitmap_spec_p (Vface_default_stipple))) { x_destroy_bitmap (f, face->stipple); @@ -1561,7 +1560,7 @@ the WIDTH times as wide as FACE on FRAME. */) { /* This is of limited utility since it works with character widths. Keep it for compatibility. --gerd. */ - int face_id = lookup_named_face (f, face, 0); + int face_id = lookup_named_face (f, face, false); struct face *width_face = (face_id < 0 ? NULL : FACE_FROM_ID (f, face_id)); @@ -1643,7 +1642,7 @@ the WIDTH times as wide as FACE on FRAME. */) #define LFACE_DISTANT_FOREGROUND(LFACE) \ AREF ((LFACE), LFACE_DISTANT_FOREGROUND_INDEX) -/* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size +/* True if LFACE is a Lisp face. A Lisp face is a vector of size LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */ #define LFACEP(LFACE) \ @@ -1773,12 +1772,12 @@ struct named_merge_point }; -/* If a face merging cycle is detected for FACE_NAME, return 0, +/* If a face merging cycle is detected for FACE_NAME, return false, otherwise add NEW_NAMED_MERGE_POINT, which is initialized using FACE_NAME and NAMED_MERGE_POINT_KIND, as the head of the linked list - pointed to by NAMED_MERGE_POINTS, and return 1. */ + pointed to by NAMED_MERGE_POINTS, and return true. */ -static int +static bool push_named_merge_point (struct named_merge_point *new_named_merge_point, Lisp_Object face_name, enum named_merge_point_kind named_merge_point_kind, @@ -1791,7 +1790,7 @@ push_named_merge_point (struct named_merge_point *new_named_merge_point, { if (prev->named_merge_point_kind == named_merge_point_kind) /* A cycle, so fail. */ - return 0; + return false; else if (prev->named_merge_point_kind == NAMED_MERGE_POINT_REMAP) /* A remap `hides ' any previous normal merge points (because the remap means that it's actually different face), @@ -1806,7 +1805,7 @@ push_named_merge_point (struct named_merge_point *new_named_merge_point, *named_merge_points = new_named_merge_point; - return 1; + return true; } @@ -1817,7 +1816,7 @@ push_named_merge_point (struct named_merge_point *new_named_merge_point, Return default face in case of errors. */ static Lisp_Object -resolve_face_name (Lisp_Object face_name, int signal_p) +resolve_face_name (Lisp_Object face_name, bool signal_p) { Lisp_Object orig_face; Lisp_Object tortoise, hare; @@ -1831,7 +1830,7 @@ resolve_face_name (Lisp_Object face_name, int signal_p) orig_face = face_name; tortoise = hare = face_name; - while (1) + while (true) { face_name = hare; hare = Fget (hare, Qface_alias); @@ -1859,12 +1858,12 @@ resolve_face_name (Lisp_Object face_name, int signal_p) /* Return the face definition of FACE_NAME on frame F. F null means return the definition for new frames. FACE_NAME may be a string or a symbol (apparently Emacs 20.2 allowed strings as face names in - face text properties; Ediff uses that). If SIGNAL_P is non-zero, - signal an error if FACE_NAME is not a valid face name. If SIGNAL_P - is zero, value is nil if FACE_NAME is not a valid face name. */ + face text properties; Ediff uses that). + If SIGNAL_P, signal an error if FACE_NAME is not a valid face name. + Otherwise, value is nil if FACE_NAME is not a valid face name. */ static Lisp_Object lface_from_face_name_no_resolve (struct frame *f, Lisp_Object face_name, - int signal_p) + bool signal_p) { Lisp_Object lface; @@ -1887,12 +1886,11 @@ lface_from_face_name_no_resolve (struct frame *f, Lisp_Object face_name, return the definition for new frames. FACE_NAME may be a string or a symbol (apparently Emacs 20.2 allowed strings as face names in face text properties; Ediff uses that). If FACE_NAME is an alias - for another face, return that face's definition. If SIGNAL_P is - non-zero, signal an error if FACE_NAME is not a valid face name. - If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face - name. */ + for another face, return that face's definition. + If SIGNAL_P, signal an error if FACE_NAME is not a valid face name. + Otherwise, value is nil if FACE_NAME is not a valid face name. */ static Lisp_Object -lface_from_face_name (struct frame *f, Lisp_Object face_name, int signal_p) +lface_from_face_name (struct frame *f, Lisp_Object face_name, bool signal_p) { face_name = resolve_face_name (face_name, signal_p); return lface_from_face_name_no_resolve (f, face_name, signal_p); @@ -1901,14 +1899,14 @@ lface_from_face_name (struct frame *f, Lisp_Object face_name, int signal_p) /* Get face attributes of face FACE_NAME from frame-local faces on frame F. Store the resulting attributes in ATTRS which must point - to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P - is non-zero, signal an error if FACE_NAME does not name a face. - Otherwise, value is zero if FACE_NAME is not a face. */ + to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. + If SIGNAL_P, signal an error if FACE_NAME does not name a face. + Otherwise, return true iff FACE_NAME is a face. */ -static int +static bool get_lface_attributes_no_remap (struct frame *f, Lisp_Object face_name, Lisp_Object attrs[LFACE_VECTOR_SIZE], - int signal_p) + bool signal_p) { Lisp_Object lface; @@ -1924,13 +1922,13 @@ get_lface_attributes_no_remap (struct frame *f, Lisp_Object face_name, /* Get face attributes of face FACE_NAME from frame-local faces on frame F. Store the resulting attributes in ATTRS which must point to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If FACE_NAME is an - alias for another face, use that face's definition. If SIGNAL_P is - non-zero, signal an error if FACE_NAME does not name a face. - Otherwise, value is zero if FACE_NAME is not a face. */ + alias for another face, use that face's definition. + If SIGNAL_P, signal an error if FACE_NAME does not name a face. + Otherwise, return true iff FACE_NAME is a face. */ -static int +static bool get_lface_attributes (struct frame *f, Lisp_Object face_name, - Lisp_Object attrs[LFACE_VECTOR_SIZE], int signal_p, + Lisp_Object attrs[LFACE_VECTOR_SIZE], bool signal_p, struct named_merge_point *named_merge_points) { Lisp_Object face_remapping; @@ -1963,10 +1961,10 @@ get_lface_attributes (struct frame *f, Lisp_Object face_name, } -/* Non-zero if all attributes in face attribute vector ATTRS are +/* True iff all attributes in face attribute vector ATTRS are specified, i.e. are non-nil. */ -static int +static bool lface_fully_specified_p (Lisp_Object attrs[LFACE_VECTOR_SIZE]) { int i; @@ -1983,13 +1981,13 @@ lface_fully_specified_p (Lisp_Object attrs[LFACE_VECTOR_SIZE]) #ifdef HAVE_WINDOW_SYSTEM /* Set font-related attributes of Lisp face LFACE from FONT-OBJECT. - If FORCE_P is zero, set only unspecified attributes of LFACE. The + If FORCE_P, set only unspecified attributes of LFACE. The exception is `font' attribute. It is set to FONT_OBJECT regardless of FORCE_P. */ -static int +static void set_lface_from_font (struct frame *f, Lisp_Object lface, - Lisp_Object font_object, int force_p) + Lisp_Object font_object, bool force_p) { Lisp_Object val; struct font *font = XFONT_OBJECT (font_object); @@ -2037,7 +2035,6 @@ set_lface_from_font (struct frame *f, Lisp_Object lface, } ASET (lface, LFACE_FONT_INDEX, font_object); - return 1; } #endif /* HAVE_WINDOW_SYSTEM */ @@ -2108,7 +2105,7 @@ merge_face_vectors (struct frame *f, Lisp_Object *from, Lisp_Object *to, other code uses `unspecified' as a generic value for face attributes. */ if (!UNSPECIFIEDP (from[LFACE_INHERIT_INDEX]) && !NILP (from[LFACE_INHERIT_INDEX])) - merge_face_ref (f, from[LFACE_INHERIT_INDEX], to, 0, named_merge_points); + merge_face_ref (f, from[LFACE_INHERIT_INDEX], to, false, named_merge_points); if (FONT_SPEC_P (from[LFACE_FONT_INDEX])) { @@ -2166,11 +2163,11 @@ merge_face_vectors (struct frame *f, Lisp_Object *from, Lisp_Object *to, } /* Merge the named face FACE_NAME on frame F, into the vector of face - attributes TO. NAMED_MERGE_POINTS is used to detect loops in face - inheritance. Returns true if FACE_NAME is a valid face name and + attributes TO. Use NAMED_MERGE_POINTS to detect loops in face + inheritance. Return true if FACE_NAME is a valid face name and merging succeeded. */ -static int +static bool merge_named_face (struct frame *f, Lisp_Object face_name, Lisp_Object *to, struct named_merge_point *named_merge_points) { @@ -2182,7 +2179,8 @@ merge_named_face (struct frame *f, Lisp_Object face_name, Lisp_Object *to, { struct gcpro gcpro1; Lisp_Object from[LFACE_VECTOR_SIZE]; - int ok = get_lface_attributes (f, face_name, from, 0, named_merge_points); + bool ok = get_lface_attributes (f, face_name, from, false, + named_merge_points); if (ok) { @@ -2194,15 +2192,15 @@ merge_named_face (struct frame *f, Lisp_Object face_name, Lisp_Object *to, return ok; } else - return 0; + return false; } /* Merge face attributes from the lisp `face reference' FACE_REF on - frame F into the face attribute vector TO. If ERR_MSGS is non-zero, + frame F into the face attribute vector TO. If ERR_MSGS, problems with FACE_REF cause an error message to be shown. Return - non-zero if no errors occurred (regardless of the value of ERR_MSGS). - NAMED_MERGE_POINTS is used to detect loops in face inheritance or + true if no errors occurred (regardless of the value of ERR_MSGS). + Use NAMED_MERGE_POINTS to detect loops in face inheritance or list structure; it may be 0 for most callers. FACE_REF may be a single face specification or a list of such @@ -2221,11 +2219,11 @@ merge_named_face (struct frame *f, Lisp_Object face_name, Lisp_Object *to, Face specifications earlier in lists take precedence over later specifications. */ -static int +static bool merge_face_ref (struct frame *f, Lisp_Object face_ref, Lisp_Object *to, - int err_msgs, struct named_merge_point *named_merge_points) + bool err_msgs, struct named_merge_point *named_merge_points) { - int ok = 1; /* Succeed without an error? */ + bool ok = true; /* Succeed without an error? */ if (CONSP (face_ref)) { @@ -2250,7 +2248,7 @@ merge_face_ref (struct frame *f, Lisp_Object face_ref, Lisp_Object *to, { if (err_msgs) add_to_log ("Invalid face color", color_name, Qnil); - ok = 0; + ok = false; } } else if (SYMBOLP (first) @@ -2261,7 +2259,7 @@ merge_face_ref (struct frame *f, Lisp_Object face_ref, Lisp_Object *to, { Lisp_Object keyword = XCAR (face_ref); Lisp_Object value = XCAR (XCDR (face_ref)); - int err = 0; + bool err = false; /* Specifying `unspecified' is a no-op. */ if (EQ (value, Qunspecified)) @@ -2274,7 +2272,7 @@ merge_face_ref (struct frame *f, Lisp_Object face_ref, Lisp_Object *to, font_clear_prop (to, FONT_FAMILY_INDEX); } else - err = 1; + err = true; } else if (EQ (keyword, QCfoundry)) { @@ -2284,7 +2282,7 @@ merge_face_ref (struct frame *f, Lisp_Object face_ref, Lisp_Object *to, font_clear_prop (to, FONT_FOUNDRY_INDEX); } else - err = 1; + err = true; } else if (EQ (keyword, QCheight)) { @@ -2297,7 +2295,7 @@ merge_face_ref (struct frame *f, Lisp_Object face_ref, Lisp_Object *to, font_clear_prop (to, FONT_SIZE_INDEX); } else - err = 1; + err = true; } else if (EQ (keyword, QCweight)) { @@ -2307,7 +2305,7 @@ merge_face_ref (struct frame *f, Lisp_Object face_ref, Lisp_Object *to, font_clear_prop (to, FONT_WEIGHT_INDEX); } else - err = 1; + err = true; } else if (EQ (keyword, QCslant)) { @@ -2317,7 +2315,7 @@ merge_face_ref (struct frame *f, Lisp_Object face_ref, Lisp_Object *to, font_clear_prop (to, FONT_SLANT_INDEX); } else - err = 1; + err = true; } else if (EQ (keyword, QCunderline)) { @@ -2327,7 +2325,7 @@ merge_face_ref (struct frame *f, Lisp_Object face_ref, Lisp_Object *to, || CONSP (value)) to[LFACE_UNDERLINE_INDEX] = value; else - err = 1; + err = true; } else if (EQ (keyword, QCoverline)) { @@ -2336,7 +2334,7 @@ merge_face_ref (struct frame *f, Lisp_Object face_ref, Lisp_Object *to, || STRINGP (value)) to[LFACE_OVERLINE_INDEX] = value; else - err = 1; + err = true; } else if (EQ (keyword, QCstrike_through)) { @@ -2345,7 +2343,7 @@ merge_face_ref (struct frame *f, Lisp_Object face_ref, Lisp_Object *to, || STRINGP (value)) to[LFACE_STRIKE_THROUGH_INDEX] = value; else - err = 1; + err = true; } else if (EQ (keyword, QCbox)) { @@ -2357,7 +2355,7 @@ merge_face_ref (struct frame *f, Lisp_Object face_ref, Lisp_Object *to, || NILP (value)) to[LFACE_BOX_INDEX] = value; else - err = 1; + err = true; } else if (EQ (keyword, QCinverse_video) || EQ (keyword, QCreverse_video)) @@ -2365,28 +2363,28 @@ merge_face_ref (struct frame *f, Lisp_Object face_ref, Lisp_Object *to, if (EQ (value, Qt) || NILP (value)) to[LFACE_INVERSE_INDEX] = value; else - err = 1; + err = true; } else if (EQ (keyword, QCforeground)) { if (STRINGP (value)) to[LFACE_FOREGROUND_INDEX] = value; else - err = 1; + err = true; } else if (EQ (keyword, QCdistant_foreground)) { if (STRINGP (value)) to[LFACE_DISTANT_FOREGROUND_INDEX] = value; else - err = 1; + err = true; } else if (EQ (keyword, QCbackground)) { if (STRINGP (value)) to[LFACE_BACKGROUND_INDEX] = value; else - err = 1; + err = true; } else if (EQ (keyword, QCstipple)) { @@ -2395,7 +2393,7 @@ merge_face_ref (struct frame *f, Lisp_Object face_ref, Lisp_Object *to, if (!NILP (pixmap_p)) to[LFACE_STIPPLE_INDEX] = value; else - err = 1; + err = true; #endif /* HAVE_WINDOW_SYSTEM */ } else if (EQ (keyword, QCwidth)) @@ -2406,14 +2404,14 @@ merge_face_ref (struct frame *f, Lisp_Object face_ref, Lisp_Object *to, font_clear_prop (to, FONT_WIDTH_INDEX); } else - err = 1; + err = true; } else if (EQ (keyword, QCfont)) { if (FONTP (value)) to[LFACE_FONT_INDEX] = value; else - err = 1; + err = true; } else if (EQ (keyword, QCinherit)) { @@ -2421,15 +2419,15 @@ merge_face_ref (struct frame *f, Lisp_Object face_ref, Lisp_Object *to, normal face reference. */ if (! merge_face_ref (f, value, to, err_msgs, named_merge_points)) - err = 1; + err = true; } else - err = 1; + err = true; if (err) { add_to_log ("Invalid face attribute %S %S", keyword, value); - ok = 0; + ok = false; } face_ref = XCDR (XCDR (face_ref)); @@ -2446,7 +2444,7 @@ merge_face_ref (struct frame *f, Lisp_Object face_ref, Lisp_Object *to, ok = merge_face_ref (f, next, to, err_msgs, named_merge_points); if (! merge_face_ref (f, first, to, err_msgs, named_merge_points)) - ok = 0; + ok = false; } } else @@ -2475,13 +2473,13 @@ Value is a vector of face attributes. */) int i; CHECK_SYMBOL (face); - global_lface = lface_from_face_name (NULL, face, 0); + global_lface = lface_from_face_name (NULL, face, false); if (!NILP (frame)) { CHECK_LIVE_FRAME (frame); f = XFRAME (frame); - lface = lface_from_face_name (f, face, 0); + lface = lface_from_face_name (f, face, false); } else f = NULL, lface = Qnil; @@ -2557,15 +2555,15 @@ Otherwise check for the existence of a global face. */) { Lisp_Object lface; - face = resolve_face_name (face, 1); + face = resolve_face_name (face, true); if (!NILP (frame)) { CHECK_LIVE_FRAME (frame); - lface = lface_from_face_name (XFRAME (frame), face, 0); + lface = lface_from_face_name (XFRAME (frame), face, false); } else - lface = lface_from_face_name (NULL, face, 0); + lface = lface_from_face_name (NULL, face, false); return lface; } @@ -2592,7 +2590,7 @@ The value is TO. */) { /* Copy global definition of FROM. We don't make copies of strings etc. because 20.2 didn't do it either. */ - lface = lface_from_face_name (NULL, from, 1); + lface = lface_from_face_name (NULL, from, true); copy = Finternal_make_lisp_face (to, Qnil); } else @@ -2602,7 +2600,7 @@ The value is TO. */) new_frame = frame; CHECK_LIVE_FRAME (frame); CHECK_LIVE_FRAME (new_frame); - lface = lface_from_face_name (XFRAME (frame), from, 1); + lface = lface_from_face_name (XFRAME (frame), from, true); copy = Finternal_make_lisp_face (to, new_frame); } @@ -2642,7 +2640,7 @@ FRAME 0 means change the face on all frames, and change the default CHECK_SYMBOL (face); CHECK_SYMBOL (attr); - face = resolve_face_name (face, 1); + face = resolve_face_name (face, true); /* If FRAME is 0, change face on all frames, and change the default for new frames. */ @@ -2658,7 +2656,7 @@ FRAME 0 means change the face on all frames, and change the default /* Set lface to the Lisp attribute vector of FACE. */ if (EQ (frame, Qt)) { - lface = lface_from_face_name (NULL, face, 1); + lface = lface_from_face_name (NULL, face, true); /* When updating face-new-frame-defaults, we put :ignore-defface where the caller wants `unspecified'. This forces the frame @@ -2675,7 +2673,7 @@ FRAME 0 means change the face on all frames, and change the default frame = selected_frame; CHECK_LIVE_FRAME (frame); - lface = lface_from_face_name (XFRAME (frame), face, 0); + lface = lface_from_face_name (XFRAME (frame), face, false); /* If a frame-local face doesn't exist yet, create one. */ if (NILP (lface)) @@ -2760,14 +2758,14 @@ FRAME 0 means change the face on all frames, and change the default } else if (EQ (attr, QCunderline)) { - bool valid_p = 0; + bool valid_p = false; if (UNSPECIFIEDP (value) || IGNORE_DEFFACE_P (value)) - valid_p = 1; + valid_p = true; else if (NILP (value) || EQ (value, Qt)) - valid_p = 1; + valid_p = true; else if (STRINGP (value) && SCHARS (value) > 0) - valid_p = 1; + valid_p = true; else if (CONSP (value)) { Lisp_Object key, val, list; @@ -2779,7 +2777,7 @@ FRAME 0 means change the face on all frames, and change the default Non-nil symbols other than t are not documented as being valid. Eg compare with inverse-video, which explicitly rejects them. */ - valid_p = 1; + valid_p = true; while (!NILP (CAR_SAFE(list))) { @@ -2790,7 +2788,7 @@ FRAME 0 means change the face on all frames, and change the default if (NILP (key) || NILP (val)) { - valid_p = 0; + valid_p = false; break; } @@ -2798,14 +2796,14 @@ FRAME 0 means change the face on all frames, and change the default && !(EQ (val, Qforeground_color) || (STRINGP (val) && SCHARS (val) > 0))) { - valid_p = 0; + valid_p = false; break; } else if (EQ (key, QCstyle) && !(EQ (val, Qline) || EQ (val, Qwave))) { - valid_p = 0; + valid_p = false; break; } } @@ -2855,9 +2853,9 @@ FRAME 0 means change the face on all frames, and change the default value = make_number (1); if (UNSPECIFIEDP (value) || IGNORE_DEFFACE_P (value)) - valid_p = 1; + valid_p = true; else if (NILP (value)) - valid_p = 1; + valid_p = true; else if (INTEGERP (value)) valid_p = XINT (value) != 0; else if (STRINGP (value)) @@ -2900,7 +2898,7 @@ FRAME 0 means change the face on all frames, and change the default valid_p = NILP (tem); } else - valid_p = 0; + valid_p = false; if (!valid_p) signal_error ("Invalid face box", value); @@ -3042,7 +3040,7 @@ FRAME 0 means change the face on all frames, and change the default signal_error ("Font not available", value); value = font_object; } - set_lface_from_font (f, lface, value, 1); + set_lface_from_font (f, lface, value, true); } } else @@ -3187,10 +3185,10 @@ FRAME 0 means change the face on all frames, and change the default struct frame *f = XFRAME (frame); if (FRAME_FACE_CACHE (f) == NULL) FRAME_FACE_CACHE (f) = make_face_cache (f); - FRAME_FACE_CACHE (f)->menu_face_changed_p = 1; + FRAME_FACE_CACHE (f)->menu_face_changed_p = true; } else - menu_face_changed_default = 1; + menu_face_changed_default = true; } if (!NILP (param)) @@ -3235,7 +3233,7 @@ update_face_from_frame_parameter (struct frame *f, Lisp_Object param, if (EQ (param, Qforeground_color)) { face = Qdefault; - lface = lface_from_face_name (f, face, 1); + lface = lface_from_face_name (f, face, true); ASET (lface, LFACE_FOREGROUND_INDEX, (STRINGP (new_value) ? new_value : Qunspecified)); realize_basic_faces (f); @@ -3251,7 +3249,7 @@ update_face_from_frame_parameter (struct frame *f, Lisp_Object param, call1 (Qframe_set_background_mode, frame); face = Qdefault; - lface = lface_from_face_name (f, face, 1); + lface = lface_from_face_name (f, face, true); ASET (lface, LFACE_BACKGROUND_INDEX, (STRINGP (new_value) ? new_value : Qunspecified)); realize_basic_faces (f); @@ -3260,21 +3258,21 @@ update_face_from_frame_parameter (struct frame *f, Lisp_Object param, else if (EQ (param, Qborder_color)) { face = Qborder; - lface = lface_from_face_name (f, face, 1); + lface = lface_from_face_name (f, face, true); ASET (lface, LFACE_BACKGROUND_INDEX, (STRINGP (new_value) ? new_value : Qunspecified)); } else if (EQ (param, Qcursor_color)) { face = Qcursor; - lface = lface_from_face_name (f, face, 1); + lface = lface_from_face_name (f, face, true); ASET (lface, LFACE_BACKGROUND_INDEX, (STRINGP (new_value) ? new_value : Qunspecified)); } else if (EQ (param, Qmouse_color)) { face = Qmouse; - lface = lface_from_face_name (f, face, 1); + lface = lface_from_face_name (f, face, true); ASET (lface, LFACE_BACKGROUND_INDEX, (STRINGP (new_value) ? new_value : Qunspecified)); } @@ -3318,7 +3316,7 @@ set_font_frame_param (Lisp_Object frame, Lisp_Object lface) return; ASET (lface, LFACE_FONT_INDEX, font); } - f->default_face_done_p = 0; + f->default_face_done_p = false; AUTO_FRAME_ARG (arg, Qfont, font); Fmodify_frame_parameters (frame, arg); } @@ -3348,11 +3346,11 @@ ordinary `x-get-resource' doesn't take a frame argument. */) /* Return resource string VALUE as a boolean value, i.e. nil, or t. If VALUE is "on" or "true", return t. If VALUE is "off" or - "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an - error; if SIGNAL_P is zero, return 0. */ + "false", return nil. Otherwise, if SIGNAL_P, signal an + error; if !SIGNAL_P, return 0. */ static Lisp_Object -face_boolean_x_resource_value (Lisp_Object value, int signal_p) +face_boolean_x_resource_value (Lisp_Object value, bool signal_p) { Lisp_Object result = make_number (0); @@ -3392,11 +3390,11 @@ DEFUN ("internal-set-lisp-face-attribute-from-resource", signal_error ("Invalid face height from X resource", value); } else if (EQ (attr, QCbold) || EQ (attr, QCitalic)) - value = face_boolean_x_resource_value (value, 1); + value = face_boolean_x_resource_value (value, true); else if (EQ (attr, QCweight) || EQ (attr, QCslant) || EQ (attr, QCwidth)) value = intern (SSDATA (value)); else if (EQ (attr, QCreverse_video) || EQ (attr, QCinverse_video)) - value = face_boolean_x_resource_value (value, 1); + value = face_boolean_x_resource_value (value, true); else if (EQ (attr, QCunderline) || EQ (attr, QCoverline) || EQ (attr, QCstrike_through)) @@ -3405,7 +3403,7 @@ DEFUN ("internal-set-lisp-face-attribute-from-resource", /* If the result of face_boolean_x_resource_value is t or nil, VALUE does NOT specify a color. */ - boolean_value = face_boolean_x_resource_value (value, 0); + boolean_value = face_boolean_x_resource_value (value, false); if (SYMBOLP (boolean_value)) value = boolean_value; } @@ -3439,10 +3437,10 @@ x_update_menu_appearance (struct frame *f) char line[512]; char *buf = line; ptrdiff_t bufsize = sizeof line; - Lisp_Object lface = lface_from_face_name (f, Qmenu, 1); + Lisp_Object lface = lface_from_face_name (f, Qmenu, true); struct face *face = FACE_FROM_ID (f, MENU_FACE_ID); const char *myname = SSDATA (Vx_resource_name); - bool changed_p = 0; + bool changed_p = false; #ifdef USE_MOTIF const char *popup_path = "popup_menu"; #else @@ -3458,7 +3456,7 @@ x_update_menu_appearance (struct frame *f) exprintf (&buf, &bufsize, line, -1, "%s.pane.menubar*foreground: %s", myname, SDATA (LFACE_FOREGROUND (lface))); XrmPutLineResource (&rdb, line); - changed_p = 1; + changed_p = true; } if (STRINGP (LFACE_BACKGROUND (lface))) @@ -3471,7 +3469,7 @@ x_update_menu_appearance (struct frame *f) exprintf (&buf, &bufsize, line, -1, "%s.pane.menubar*background: %s", myname, SDATA (LFACE_BACKGROUND (lface))); XrmPutLineResource (&rdb, line); - changed_p = 1; + changed_p = true; } if (face->font @@ -3514,7 +3512,7 @@ x_update_menu_appearance (struct frame *f) exprintf (&buf, &bufsize, line, -1, "%s.%s*font%s: %s", myname, popup_path, suffix, fontsetname); XrmPutLineResource (&rdb, line); - changed_p = 1; + changed_p = true; if (fontsetname != SSDATA (xlfd)) xfree (fontsetname); } @@ -3581,7 +3579,7 @@ frames). If FRAME is omitted or nil, use the selected frame. */) (Lisp_Object symbol, Lisp_Object keyword, Lisp_Object frame) { struct frame *f = EQ (frame, Qt) ? NULL : decode_live_frame (frame); - Lisp_Object lface = lface_from_face_name (f, symbol, 1), value = Qnil; + Lisp_Object lface = lface_from_face_name (f, symbol, true), value = Qnil; CHECK_SYMBOL (symbol); CHECK_SYMBOL (keyword); @@ -3664,8 +3662,8 @@ Default face attributes override any local face attributes. */) struct frame *f = XFRAME (frame); CHECK_LIVE_FRAME (frame); - global_lface = lface_from_face_name (NULL, face, 1); - local_lface = lface_from_face_name (f, face, 0); + global_lface = lface_from_face_name (NULL, face, true); + local_lface = lface_from_face_name (f, face, false); if (NILP (local_lface)) local_lface = Finternal_make_lisp_face (face, frame); @@ -3754,7 +3752,7 @@ return the font name used for CHARACTER. */) if (EQ (frame, Qt)) { Lisp_Object result = Qnil; - Lisp_Object lface = lface_from_face_name (NULL, face, 1); + Lisp_Object lface = lface_from_face_name (NULL, face, true); if (!UNSPECIFIEDP (LFACE_WEIGHT (lface)) && !EQ (LFACE_WEIGHT (lface), Qnormal)) @@ -3769,7 +3767,7 @@ return the font name used for CHARACTER. */) else { struct frame *f = decode_live_frame (frame); - int face_id = lookup_named_face (f, face, 1); + int face_id = lookup_named_face (f, face, true); struct face *fface = FACE_FROM_ID (f, face_id); if (! fface) @@ -3794,7 +3792,7 @@ return the font name used for CHARACTER. */) } -/* Compare face-attribute values v1 and v2 for equality. Value is non-zero if +/* Compare face-attribute values v1 and v2 for equality. Value is true if all attributes are `equal'. Tries to be fast because this function is called quite often. */ @@ -3804,22 +3802,22 @@ face_attr_equal_p (Lisp_Object v1, Lisp_Object v2) /* Type can differ, e.g. when one attribute is unspecified, i.e. nil, and the other is specified. */ if (XTYPE (v1) != XTYPE (v2)) - return 0; + return false; if (EQ (v1, v2)) - return 1; + return true; switch (XTYPE (v1)) { case Lisp_String: if (SBYTES (v1) != SBYTES (v2)) - return 0; + return false; return memcmp (SDATA (v1), SDATA (v2), SBYTES (v1)) == 0; case_Lisp_Int: case Lisp_Symbol: - return 0; + return false; default: return !NILP (Fequal (v1, v2)); @@ -3827,7 +3825,7 @@ face_attr_equal_p (Lisp_Object v1, Lisp_Object v2) } -/* Compare face vectors V1 and V2 for equality. Value is non-zero if +/* Compare face vectors V1 and V2 for equality. Value is true if all attributes are `equal'. Tries to be fast because this function is called quite often. */ @@ -3835,7 +3833,7 @@ static bool lface_equal_p (Lisp_Object *v1, Lisp_Object *v2) { int i; - bool equal_p = 1; + bool equal_p = true; for (i = 1; i < LFACE_VECTOR_SIZE && equal_p; ++i) equal_p = face_attr_equal_p (v1[i], v2[i]); @@ -3852,7 +3850,7 @@ If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames). If FRAME is omitted or nil, use the selected frame. */) (Lisp_Object face1, Lisp_Object face2, Lisp_Object frame) { - int equal_p; + bool equal_p; struct frame *f; Lisp_Object lface1, lface2; @@ -3862,8 +3860,8 @@ If FRAME is omitted or nil, use the selected frame. */) Emacs. That frame is not an X frame. */ f = EQ (frame, Qt) ? NULL : decode_live_frame (frame); - lface1 = lface_from_face_name (f, face1, 1); - lface2 = lface_from_face_name (f, face2, 1); + lface1 = lface_from_face_name (f, face1, true); + lface2 = lface_from_face_name (f, face2, true); equal_p = lface_equal_p (XVECTOR (lface1)->contents, XVECTOR (lface2)->contents); return equal_p ? Qt : Qnil; @@ -3879,7 +3877,7 @@ If FRAME is omitted or nil, use the selected frame. */) (Lisp_Object face, Lisp_Object frame) { struct frame *f = EQ (frame, Qt) ? NULL : decode_live_frame (frame); - Lisp_Object lface = lface_from_face_name (f, face, 1); + Lisp_Object lface = lface_from_face_name (f, face, true); int i; for (i = 1; i < LFACE_VECTOR_SIZE; ++i) @@ -3932,12 +3930,12 @@ lface_hash (Lisp_Object *v) #ifdef HAVE_WINDOW_SYSTEM -/* Return non-zero if LFACE1 and LFACE2 specify the same font (without +/* Return true if LFACE1 and LFACE2 specify the same font (without considering charsets/registries). They do if they specify the same family, point size, weight, width, slant, and font. Both LFACE1 and LFACE2 must be fully-specified. */ -static int +static bool lface_same_font_attributes_p (Lisp_Object *lface1, Lisp_Object *lface2) { eassert (lface_fully_specified_p (lface1) @@ -4094,10 +4092,12 @@ If FRAME is unspecified or nil, the current frame is used. */) XColor cdef1, cdef2; if (!(CONSP (color1) && parse_rgb_list (color1, &cdef1)) - && !(STRINGP (color1) && defined_color (f, SSDATA (color1), &cdef1, 0))) + && !(STRINGP (color1) + && defined_color (f, SSDATA (color1), &cdef1, false))) signal_error ("Invalid color", color1); if (!(CONSP (color2) && parse_rgb_list (color2, &cdef2)) - && !(STRINGP (color2) && defined_color (f, SSDATA (color2), &cdef2, 0))) + && !(STRINGP (color2) + && defined_color (f, SSDATA (color2), &cdef2, false))) signal_error ("Invalid color", color2); return make_number (color_distance (&cdef1, &cdef2)); @@ -4413,7 +4413,7 @@ face_for_font (struct frame *f, Lisp_Object font_object, struct face *base_face) face isn't realized and cannot be realized. */ int -lookup_named_face (struct frame *f, Lisp_Object symbol, int signal_p) +lookup_named_face (struct frame *f, Lisp_Object symbol, bool signal_p) { Lisp_Object attrs[LFACE_VECTOR_SIZE]; Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE]; @@ -4480,7 +4480,7 @@ lookup_basic_face (struct frame *f, int face_id) /* If there is a remapping entry, lookup the face using NAME, which will handle the remapping too. */ - remapped_face_id = lookup_named_face (f, name, 0); + remapped_face_id = lookup_named_face (f, name, false); if (remapped_face_id < 0) return face_id; /* Give up. */ @@ -4582,7 +4582,7 @@ face_with_height (struct frame *f, int face_id, int height) int lookup_derived_face (struct frame *f, Lisp_Object symbol, int face_id, - int signal_p) + bool signal_p) { Lisp_Object attrs[LFACE_VECTOR_SIZE]; Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE]; @@ -4608,7 +4608,7 @@ DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector, lface = Fmake_vector (make_number (LFACE_VECTOR_SIZE), Qunspecified); merge_face_ref (XFRAME (selected_frame), plist, XVECTOR (lface)->contents, - 1, 0); + true, 0); return lface; } @@ -4673,7 +4673,7 @@ x_supports_face_attributes_p (struct frame *f, || (!UNSPECIFIEDP (attrs[LFACE_BOX_INDEX]) && face_attr_equal_p (attrs[LFACE_BOX_INDEX], def_attrs[LFACE_BOX_INDEX]))) - return 0; + return false; /* Check font-related attributes, as those are the most commonly "unsupported" on a window-system (because of missing fonts). */ @@ -4703,7 +4703,7 @@ x_supports_face_attributes_p (struct frame *f, supported. */ if (face->font == def_face->font || ! face->font) - return 0; + return false; for (i = FONT_TYPE_INDEX; i <= FONT_SIZE_INDEX; i++) if (! EQ (face->font->props[i], def_face->font->props[i])) { @@ -4711,18 +4711,18 @@ x_supports_face_attributes_p (struct frame *f, if (i < FONT_FOUNDRY_INDEX || i > FONT_REGISTRY_INDEX || face->font->driver->case_sensitive) - return 1; + return true; s1 = SYMBOL_NAME (face->font->props[i]); s2 = SYMBOL_NAME (def_face->font->props[i]); if (! EQ (Fcompare_strings (s1, make_number (0), Qnil, s2, make_number (0), Qnil, Qt), Qt)) - return 1; + return true; } - return 0; + return false; } /* Everything checks out, this face is supported. */ - return 1; + return true; } #endif /* HAVE_WINDOW_SYSTEM */ @@ -4771,7 +4771,7 @@ tty_supports_face_attributes_p (struct frame *f, || !UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX]) || !UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX]) || !UNSPECIFIEDP (attrs[LFACE_BOX_INDEX])) - return 0; + return false; /* Test for terminal `capabilities' (non-color character attributes). */ @@ -4785,17 +4785,17 @@ tty_supports_face_attributes_p (struct frame *f, if (weight > 100) { if (def_weight > 100) - return 0; /* same as default */ + return false; /* same as default */ test_caps = TTY_CAP_BOLD; } else if (weight < 100) { if (def_weight < 100) - return 0; /* same as default */ + return false; /* same as default */ test_caps = TTY_CAP_DIM; } else if (def_weight == 100) - return 0; /* same as default */ + return false; /* same as default */ } /* font slant */ @@ -4805,7 +4805,7 @@ tty_supports_face_attributes_p (struct frame *f, { int def_slant = FONT_SLANT_NAME_NUMERIC (def_attrs[LFACE_SLANT_INDEX]); if (slant == 100 || slant == def_slant) - return 0; /* same as default */ + return false; /* same as default */ else test_caps |= TTY_CAP_ITALIC; } @@ -4815,11 +4815,11 @@ tty_supports_face_attributes_p (struct frame *f, if (!UNSPECIFIEDP (val)) { if (STRINGP (val)) - return 0; /* ttys can't use colored underlines */ + return false; /* ttys can't use colored underlines */ else if (EQ (CAR_SAFE (val), QCstyle) && EQ (CAR_SAFE (CDR_SAFE (val)), Qwave)) - return 0; /* ttys can't use wave underlines */ + return false; /* ttys can't use wave underlines */ else if (face_attr_equal_p (val, def_attrs[LFACE_UNDERLINE_INDEX])) - return 0; /* same as default */ + return false; /* same as default */ else test_caps |= TTY_CAP_UNDERLINE; } @@ -4829,7 +4829,7 @@ tty_supports_face_attributes_p (struct frame *f, if (!UNSPECIFIEDP (val)) { if (face_attr_equal_p (val, def_attrs[LFACE_INVERSE_INDEX])) - return 0; /* same as default */ + return false; /* same as default */ else test_caps |= TTY_CAP_INVERSE; } @@ -4844,12 +4844,12 @@ tty_supports_face_attributes_p (struct frame *f, Lisp_Object def_fg = def_attrs[LFACE_FOREGROUND_INDEX]; if (face_attr_equal_p (fg, def_fg)) - return 0; /* same as default */ + return false; /* same as default */ else if (! tty_lookup_color (f, fg, &fg_tty_color, &fg_std_color)) - return 0; /* not a valid color */ + return false; /* not a valid color */ else if (color_distance (&fg_tty_color, &fg_std_color) > TTY_SAME_COLOR_THRESHOLD) - return 0; /* displayed color is too different */ + return false; /* displayed color is too different */ else /* Make sure the color is really different than the default. */ { @@ -4857,7 +4857,7 @@ tty_supports_face_attributes_p (struct frame *f, if (tty_lookup_color (f, def_fg, &def_fg_color, 0) && (color_distance (&fg_tty_color, &def_fg_color) <= TTY_SAME_COLOR_THRESHOLD)) - return 0; + return false; } } @@ -4868,12 +4868,12 @@ tty_supports_face_attributes_p (struct frame *f, Lisp_Object def_bg = def_attrs[LFACE_BACKGROUND_INDEX]; if (face_attr_equal_p (bg, def_bg)) - return 0; /* same as default */ + return false; /* same as default */ else if (! tty_lookup_color (f, bg, &bg_tty_color, &bg_std_color)) - return 0; /* not a valid color */ + return false; /* not a valid color */ else if (color_distance (&bg_tty_color, &bg_std_color) > TTY_SAME_COLOR_THRESHOLD) - return 0; /* displayed color is too different */ + return false; /* displayed color is too different */ else /* Make sure the color is really different than the default. */ { @@ -4881,7 +4881,7 @@ tty_supports_face_attributes_p (struct frame *f, if (tty_lookup_color (f, def_bg, &def_bg_color, 0) && (color_distance (&bg_tty_color, &def_bg_color) <= TTY_SAME_COLOR_THRESHOLD)) - return 0; + return false; } } @@ -4896,7 +4896,7 @@ tty_supports_face_attributes_p (struct frame *f, - color_distance (&fg_tty_color, &bg_tty_color)); if (delta_delta > TTY_SAME_COLOR_THRESHOLD || delta_delta < -TTY_SAME_COLOR_THRESHOLD) - return 0; + return false; } @@ -4927,7 +4927,7 @@ satisfied by the tty display code's automatic substitution of a `dim' face for italic. */) (Lisp_Object attributes, Lisp_Object display) { - bool supports = 0; + bool supports = false; int i; Lisp_Object frame; struct frame *f; @@ -4962,7 +4962,7 @@ face for italic. */) for (i = 0; i < LFACE_VECTOR_SIZE; i++) attrs[i] = Qunspecified; - merge_face_ref (f, attributes, attrs, 1, 0); + merge_face_ref (f, attributes, attrs, true, 0); def_face = FACE_FROM_ID (f, DEFAULT_FACE_ID); if (def_face == NULL) @@ -5140,7 +5140,7 @@ face_fontset (Lisp_Object attrs[LFACE_VECTOR_SIZE]) static bool realize_basic_faces (struct frame *f) { - bool success_p = 0; + bool success_p = false; ptrdiff_t count = SPECPDL_INDEX (); /* Block input here so that we won't be surprised by an X expose @@ -5170,14 +5170,14 @@ realize_basic_faces (struct frame *f) /* Reflect changes in the `menu' face in menu bars. */ if (FRAME_FACE_CACHE (f)->menu_face_changed_p) { - FRAME_FACE_CACHE (f)->menu_face_changed_p = 0; + FRAME_FACE_CACHE (f)->menu_face_changed_p = false; #ifdef USE_X_TOOLKIT if (FRAME_WINDOW_P (f)) x_update_menu_appearance (f); #endif } - success_p = 1; + success_p = true; } unbind_to (count, Qnil); @@ -5199,7 +5199,7 @@ realize_default_face (struct frame *f) struct face *face; /* If the `default' face is not yet known, create it. */ - lface = lface_from_face_name (f, Qdefault, 0); + lface = lface_from_face_name (f, Qdefault, false); if (NILP (lface)) { Lisp_Object frame; @@ -5215,7 +5215,7 @@ realize_default_face (struct frame *f) XSETFONT (font_object, FRAME_FONT (f)); set_lface_from_font (f, lface, font_object, f->default_face_done_p); ASET (lface, LFACE_FONTSET_INDEX, fontset_name (FRAME_FONTSET (f))); - f->default_face_done_p = 1; + f->default_face_done_p = true; } #endif /* HAVE_WINDOW_SYSTEM */ @@ -5257,7 +5257,7 @@ realize_default_face (struct frame *f) if (CONSP (color) && STRINGP (XCDR (color))) ASET (lface, LFACE_FOREGROUND_INDEX, XCDR (color)); else if (FRAME_WINDOW_P (f)) - return 0; + return false; else if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)) ASET (lface, LFACE_FOREGROUND_INDEX, build_string (unspecified_fg)); else @@ -5272,7 +5272,7 @@ realize_default_face (struct frame *f) if (CONSP (color) && STRINGP (XCDR (color))) ASET (lface, LFACE_BACKGROUND_INDEX, XCDR (color)); else if (FRAME_WINDOW_P (f)) - return 0; + return false; else if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)) ASET (lface, LFACE_BACKGROUND_INDEX, build_string (unspecified_bg)); else @@ -5295,7 +5295,7 @@ realize_default_face (struct frame *f) /* This can happen when making a frame on a display that does not support the default font. */ if (!face->font) - return 0; + return false; /* Otherwise, the font specified for the frame was not acceptable as a font for the default face (perhaps because @@ -5305,7 +5305,7 @@ realize_default_face (struct frame *f) } #endif /* HAVE_X_WINDOWS */ #endif /* HAVE_WINDOW_SYSTEM */ - return 1; + return true; } @@ -5317,12 +5317,12 @@ static void realize_named_face (struct frame *f, Lisp_Object symbol, int id) { struct face_cache *c = FRAME_FACE_CACHE (f); - Lisp_Object lface = lface_from_face_name (f, symbol, 0); + Lisp_Object lface = lface_from_face_name (f, symbol, false); Lisp_Object attrs[LFACE_VECTOR_SIZE]; Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE]; /* The default face must exist and be fully specified. */ - get_lface_attributes_no_remap (f, Qdefault, attrs, 1); + get_lface_attributes_no_remap (f, Qdefault, attrs, true); check_lface_attrs (attrs); eassert (lface_fully_specified_p (attrs)); @@ -5335,7 +5335,7 @@ realize_named_face (struct frame *f, Lisp_Object symbol, int id) } /* Merge SYMBOL's face with the default face. */ - get_lface_attributes_no_remap (f, symbol, symbol_attrs, 1); + get_lface_attributes_no_remap (f, symbol, symbol_attrs, true); merge_face_vectors (f, symbol_attrs, attrs, 0); /* Realize the face. */ @@ -5407,7 +5407,7 @@ realize_non_ascii_face (struct frame *f, Lisp_Object font_object, && FONT_WEIGHT_NUMERIC (font_object) <= 100); /* Don't try to free the colors copied bitwise from BASE_FACE. */ - face->colors_copied_bitwise_p = 1; + face->colors_copied_bitwise_p = true; face->font = NILP (font_object) ? NULL : XFONT_OBJECT (font_object); face->gc = 0; @@ -5491,7 +5491,7 @@ realize_x_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE]) if (face->font && FONT_WEIGHT_NAME_NUMERIC (attrs[LFACE_WEIGHT_INDEX]) > 100 && FONT_WEIGHT_NUMERIC (attrs[LFACE_FONT_INDEX]) <= 100) - face->overstrike = 1; + face->overstrike = true; /* Load colors, and set remaining attributes. */ @@ -5516,7 +5516,7 @@ realize_x_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE]) face->box = FACE_SIMPLE_BOX; face->box_line_width = XINT (box); face->box_color = face->foreground; - face->box_color_defaulted_p = 1; + face->box_color_defaulted_p = true; } else if (CONSP (box)) { @@ -5524,7 +5524,7 @@ realize_x_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE]) being one of `raised' or `sunken'. */ face->box = FACE_SIMPLE_BOX; face->box_color = face->foreground; - face->box_color_defaulted_p = 1; + face->box_color_defaulted_p = true; face->box_line_width = 1; while (CONSP (box)) @@ -5550,7 +5550,7 @@ realize_x_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE]) { face->box_color = load_color (f, face, value, LFACE_BOX_INDEX); - face->use_box_color_for_shadows_p = 1; + face->use_box_color_for_shadows_p = true; } } else if (EQ (keyword, QCstyle)) @@ -5569,34 +5569,34 @@ realize_x_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE]) if (EQ (underline, Qt)) { /* Use default color (same as foreground color). */ - face->underline_p = 1; + face->underline_p = true; face->underline_type = FACE_UNDER_LINE; - face->underline_defaulted_p = 1; + face->underline_defaulted_p = true; face->underline_color = 0; } else if (STRINGP (underline)) { /* Use specified color. */ - face->underline_p = 1; + face->underline_p = true; face->underline_type = FACE_UNDER_LINE; - face->underline_defaulted_p = 0; + face->underline_defaulted_p = false; face->underline_color = load_color (f, face, underline, LFACE_UNDERLINE_INDEX); } else if (NILP (underline)) { - face->underline_p = 0; - face->underline_defaulted_p = 0; + face->underline_p = false; + face->underline_defaulted_p = false; face->underline_color = 0; } else if (CONSP (underline)) { /* `(:color COLOR :style STYLE)'. STYLE being one of `line' or `wave'. */ - face->underline_p = 1; + face->underline_p = true; face->underline_color = 0; - face->underline_defaulted_p = 1; + face->underline_defaulted_p = true; face->underline_type = FACE_UNDER_LINE; /* FIXME? This is also not robust about checking the precise form. @@ -5617,12 +5617,12 @@ realize_x_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE]) { if (EQ (value, Qforeground_color)) { - face->underline_defaulted_p = 1; + face->underline_defaulted_p = true; face->underline_color = 0; } else if (STRINGP (value)) { - face->underline_defaulted_p = 0; + face->underline_defaulted_p = false; face->underline_color = load_color (f, face, value, LFACE_UNDERLINE_INDEX); } @@ -5643,13 +5643,13 @@ realize_x_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE]) face->overline_color = load_color (f, face, attrs[LFACE_OVERLINE_INDEX], LFACE_OVERLINE_INDEX); - face->overline_p = 1; + face->overline_p = true; } else if (EQ (overline, Qt)) { face->overline_color = face->foreground; - face->overline_color_defaulted_p = 1; - face->overline_p = 1; + face->overline_color_defaulted_p = true; + face->overline_p = true; } strike_through = attrs[LFACE_STRIKE_THROUGH_INDEX]; @@ -5658,13 +5658,13 @@ realize_x_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE]) face->strike_through_color = load_color (f, face, attrs[LFACE_STRIKE_THROUGH_INDEX], LFACE_STRIKE_THROUGH_INDEX); - face->strike_through_p = 1; + face->strike_through_p = true; } else if (EQ (strike_through, Qt)) { face->strike_through_color = face->foreground; - face->strike_through_color_defaulted_p = 1; - face->strike_through_p = 1; + face->strike_through_color_defaulted_p = true; + face->strike_through_p = true; } stipple = attrs[LFACE_STIPPLE_INDEX]; @@ -5678,15 +5678,15 @@ realize_x_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE]) /* Map a specified color of face FACE on frame F to a tty color index. IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and - specifies which color to map. Set *DEFAULTED to 1 if mapping to the + specifies which color to map. Set *DEFAULTED to true if mapping to the default foreground/background colors. */ static void map_tty_color (struct frame *f, struct face *face, - enum lface_attribute_index idx, int *defaulted) + enum lface_attribute_index idx, bool *defaulted) { Lisp_Object frame, color, def; - int foreground_p = idx == LFACE_FOREGROUND_INDEX; + bool foreground_p = idx == LFACE_FOREGROUND_INDEX; unsigned long default_pixel = foreground_p ? FACE_TTY_DEFAULT_FG_COLOR : FACE_TTY_DEFAULT_BG_COLOR; unsigned long pixel = default_pixel; @@ -5728,7 +5728,7 @@ map_tty_color (struct frame *f, struct face *face, else pixel = FRAME_BACKGROUND_PIXEL (f); face->lface[idx] = tty_color_name (f, pixel); - *defaulted = 1; + *defaulted = true; } else if (pixel == default_other_pixel) { @@ -5737,7 +5737,7 @@ map_tty_color (struct frame *f, struct face *face, else pixel = FRAME_FOREGROUND_PIXEL (f); face->lface[idx] = tty_color_name (f, pixel); - *defaulted = 1; + *defaulted = true; } } #endif /* MSDOS */ @@ -5760,7 +5760,7 @@ realize_tty_face (struct face_cache *cache, { struct face *face; int weight, slant; - int face_colors_defaulted = 0; + bool face_colors_defaulted = false; struct frame *f = cache->f; /* Frame must be a termcap frame. */ @@ -5768,7 +5768,7 @@ realize_tty_face (struct face_cache *cache, /* Allocate a new realized face. */ face = make_realized_face (attrs); -#if 0 +#if false face->font_name = FRAME_MSDOS_P (cache->f) ? "ms-dos" : "tty"; #endif @@ -5776,13 +5776,13 @@ realize_tty_face (struct face_cache *cache, weight = FONT_WEIGHT_NAME_NUMERIC (attrs[LFACE_WEIGHT_INDEX]); slant = FONT_SLANT_NAME_NUMERIC (attrs[LFACE_SLANT_INDEX]); if (weight > 100) - face->tty_bold_p = 1; + face->tty_bold_p = true; if (slant != 100) - face->tty_italic_p = 1; + face->tty_italic_p = true; if (!NILP (attrs[LFACE_UNDERLINE_INDEX])) - face->tty_underline_p = 1; + face->tty_underline_p = true; if (!NILP (attrs[LFACE_INVERSE_INDEX])) - face->tty_reverse_p = 1; + face->tty_reverse_p = true; /* Map color names to color indices. */ map_tty_color (f, face, LFACE_FOREGROUND_INDEX, &face_colors_defaulted); @@ -5802,7 +5802,7 @@ realize_tty_face (struct face_cache *cache, && face->tty_bold_p && face->background == FACE_TTY_DEFAULT_FG_COLOR && face->foreground == FACE_TTY_DEFAULT_BG_COLOR) - face->tty_bold_p = 0; + face->tty_bold_p = false; return face; } @@ -5851,7 +5851,7 @@ compute_char_face (struct frame *f, int ch, Lisp_Object prop) Lisp_Object attrs[LFACE_VECTOR_SIZE]; struct face *default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID); memcpy (attrs, default_face->lface, sizeof attrs); - merge_face_ref (f, prop, attrs, 1, 0); + merge_face_ref (f, prop, attrs, true, 0); face_id = lookup_face (f, attrs); } @@ -5869,7 +5869,7 @@ compute_char_face (struct frame *f, int ch, Lisp_Object prop) LIMIT is a position not to scan beyond. That is to limit the time this function can take. - If MOUSE is non-zero, use the character's mouse-face, not its face. + If MOUSE, use the character's mouse-face, not its face. BASE_FACE_ID, if non-negative, specifies a base face id to use instead of DEFAULT_FACE_ID. @@ -5879,7 +5879,7 @@ compute_char_face (struct frame *f, int ch, Lisp_Object prop) int face_at_buffer_position (struct window *w, ptrdiff_t pos, ptrdiff_t *endptr, ptrdiff_t limit, - int mouse, int base_face_id) + bool mouse, int base_face_id) { struct frame *f = XFRAME (w->frame); Lisp_Object attrs[LFACE_VECTOR_SIZE]; @@ -5912,7 +5912,7 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos, { ptrdiff_t next_overlay; - GET_OVERLAYS_AT (pos, overlay_vec, noverlays, &next_overlay, 0); + GET_OVERLAYS_AT (pos, overlay_vec, noverlays, &next_overlay, false); if (next_overlay < endpos) endpos = next_overlay; } @@ -5945,7 +5945,7 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos, /* Merge in attributes specified via text properties. */ if (!NILP (prop)) - merge_face_ref (f, prop, attrs, 1, 0); + merge_face_ref (f, prop, attrs, true, 0); /* Now merge the overlay data. */ noverlays = sort_overlays (overlay_vec, noverlays, w); @@ -5956,7 +5956,7 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos, prop = Foverlay_get (overlay_vec[i], propname); if (!NILP (prop)) - merge_face_ref (f, prop, attrs, 1, 0); + merge_face_ref (f, prop, attrs, true, 0); oend = OVERLAY_END (overlay_vec[i]); oendpos = OVERLAY_POSITION (oend); @@ -5982,7 +5982,7 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos, int face_for_overlay_string (struct window *w, ptrdiff_t pos, ptrdiff_t *endptr, ptrdiff_t limit, - int mouse, Lisp_Object overlay) + bool mouse, Lisp_Object overlay) { struct frame *f = XFRAME (w->frame); Lisp_Object attrs[LFACE_VECTOR_SIZE]; @@ -6021,7 +6021,7 @@ face_for_overlay_string (struct window *w, ptrdiff_t pos, /* Merge in attributes specified via text properties. */ if (!NILP (prop)) - merge_face_ref (f, prop, attrs, 1, 0); + merge_face_ref (f, prop, attrs, true, 0); *endptr = endpos; @@ -6043,7 +6043,7 @@ face_for_overlay_string (struct window *w, ptrdiff_t pos, BASE_FACE_ID is the id of a face to merge with. For strings coming from overlays or the `display' property it is the face at BUFPOS. - If MOUSE_P is non-zero, use the character's mouse-face, not its face. + If MOUSE_P, use the character's mouse-face, not its face. Set *ENDPTR to the next position where to check for faces in STRING; -1 if the face is constant from POS to the end of the @@ -6056,7 +6056,7 @@ int face_at_string_position (struct window *w, Lisp_Object string, ptrdiff_t pos, ptrdiff_t bufpos, ptrdiff_t *endptr, enum face_id base_face_id, - int mouse_p) + bool mouse_p) { Lisp_Object prop, position, end, limit; struct frame *f = XFRAME (WINDOW_FRAME (w)); @@ -6101,7 +6101,7 @@ face_at_string_position (struct window *w, Lisp_Object string, /* Merge in attributes specified via text properties. */ if (!NILP (prop)) - merge_face_ref (f, prop, attrs, 1, 0); + merge_face_ref (f, prop, attrs, true, 0); /* Look up a realized face with the given face attributes, or realize a new one for ASCII characters. */ diff --git a/test/ChangeLog b/test/ChangeLog index d8cd36790f2..61ab8b6595a 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -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 ]'. diff --git a/test/automated/cl-generic-tests.el b/test/automated/cl-generic-tests.el index bc9a1ece423..5194802fa00 100644 --- a/test/automated/cl-generic-tests.el +++ b/test/automated/cl-generic-tests.el @@ -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 |