------------------------------------------------------------ revno: 118140 committer: Michal Nazarewicz branch nick: emacs-trunk timestamp: Fri 2014-10-17 09:28:25 +0200 message: Fix lisp/ChangeLog entry added in rev. 118139 diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-17 07:20:51 +0000 +++ lisp/ChangeLog 2014-10-17 07:28:25 +0000 @@ -1,4 +1,4 @@ -2014-06-05 Michal Nazarewicz +2014-10-17 Michal Nazarewicz * textmodes/tildify.el (tildify--pick-alist-entry): rename from tildify-mode-alist. ------------------------------------------------------------ revno: 118139 committer: Michal Nazarewicz branch nick: emacs-trunk timestamp: Fri 2014-10-17 09:20:51 +0200 message: tildify.el (tildify--pick-alist-entry): rename from tildify-mode-alist tildify-mode-alist does not really describe what the functino does so rename it to tildify--pick-alist-entry. This also makes it clear that the function is an internal one. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-17 05:09:24 +0000 +++ lisp/ChangeLog 2014-10-17 07:20:51 +0000 @@ -1,3 +1,8 @@ +2014-06-05 Michal Nazarewicz + + * textmodes/tildify.el (tildify--pick-alist-entry): rename from + tildify-mode-alist. + 2014-10-17 Stefan Monnier * emacs-lisp/eieio.el: Use lexical-binding drop non-GV fallback. === modified file 'lisp/textmodes/tildify.el' --- lisp/textmodes/tildify.el 2014-06-05 14:42:07 +0000 +++ lisp/textmodes/tildify.el 2014-10-17 07:20:51 +0000 @@ -4,7 +4,7 @@ ;; Author: Milan Zamazal ;; Michal Nazarewicz -;; Version: 4.5.3 +;; Version: 4.5.4 ;; Keywords: text, TeX, SGML, wp ;; This file is part of GNU Emacs. @@ -226,13 +226,13 @@ ;;; *** Auxiliary functions *** -(defun tildify-mode-alist (mode-alist &optional mode) +(defun tildify--pick-alist-entry (mode-alist &optional mode) "Return alist item for the MODE-ALIST in the current major MODE." (let ((alist (cdr (or (assoc (or mode major-mode) mode-alist) (assoc t mode-alist))))) (if (and alist (symbolp alist)) - (tildify-mode-alist mode-alist alist) + (tildify--pick-alist-entry mode-alist alist) alist))) (defun tildify-foreach-region-outside-env (beg end callback) @@ -244,7 +244,7 @@ region as soon as CALLBACK returns nil. Environments to ignore are determined from `tildify-ignored-environments-alist'." (declare (indent 2)) - (let ((pairs (tildify-mode-alist tildify-ignored-environments-alist))) + (let ((pairs (tildify--pick-alist-entry tildify-ignored-environments-alist))) (if (not pairs) (funcall callback beg end) (let ((func (lambda (b e) @@ -300,10 +300,10 @@ (quit), force (replace without further questions)." (save-excursion (goto-char beg) - (let* ((alist (tildify-mode-alist tildify-pattern-alist)) + (let* ((alist (tildify--pick-alist-entry tildify-pattern-alist)) (regexp (car alist)) (match-number (cadr alist)) - (tilde (tildify-mode-alist tildify-string-alist)) + (tilde (tildify--pick-alist-entry tildify-string-alist)) (end-marker (copy-marker end)) answer bad-answer ------------------------------------------------------------ revno: 118138 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2014-10-17 01:09:24 -0400 message: * lisp/emacs-lisp/eieio-base.el: Use lexical-binding and cl-lib. * lisp/emacs-lisp/eieio-core.el: Use lexical-binding and cl-lib. (list-of): New type. (eieio--typep): Remove. (eieio-perform-slot-validation): Use cl-typep instead. * lisp/emacs-lisp/eieio.el: Use lexical-binding drop non-GV fallback. (defclass, defgeneric, defmethod): Add doc-string position. (with-slots): Require cl-lib. * lisp/emacs-lisp/cl-macs.el (cl--make-type-test): Avoid ((lambda ..) ..). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-16 20:29:44 +0000 +++ lisp/ChangeLog 2014-10-17 05:09:24 +0000 @@ -1,10 +1,25 @@ +2014-10-17 Stefan Monnier + + * emacs-lisp/eieio.el: Use lexical-binding drop non-GV fallback. + (defclass, defgeneric, defmethod): Add doc-string position. + (with-slots): Require cl-lib. + + * emacs-lisp/eieio-core.el: Use lexical-binding and cl-lib. + (list-of): New type. + (eieio--typep): Remove. + (eieio-perform-slot-validation): Use cl-typep instead. + + * emacs-lisp/eieio-base.el: Use lexical-binding and cl-lib. + + * emacs-lisp/cl-macs.el (cl--make-type-test): Avoid ((lambda ..) ..). + 2014-10-16 Alan Mackenzie Trigger showing when point is in the "periphery" of a line or just inside a paren. * paren.el (show-paren-style, show-paren-delay) - (show-paren-priority, show-paren-ring-bell-on-mismatch): Remove - superfluous :group specifications. + (show-paren-priority, show-paren-ring-bell-on-mismatch): + Remove superfluous :group specifications. (show-paren-when-point-inside-paren) (show-paren-when-point-in-periphery): New customizable variables. (show-paren-highlight-openparen): Make into a defcustom. @@ -532,7 +547,7 @@ * term.el (term-mouse-paste): * mouse.el (mouse-yank-primary): Use gui-get-primary-selection. -2014-10-02 H. Dieter Wilhelm (tiny change) +2014-10-02 H. Dieter Wilhelm * calc/calc-help.el (calc-describe-thing): Quote strings which could look like regexps. === modified file 'lisp/emacs-lisp/cl-macs.el' --- lisp/emacs-lisp/cl-macs.el 2014-07-21 01:41:59 +0000 +++ lisp/emacs-lisp/cl-macs.el 2014-10-17 05:09:24 +0000 @@ -822,7 +822,8 @@ "repeat" "while" "until" "always" "never" "thereis" "collect" "append" "nconc" "sum" "count" "maximize" "minimize" "if" "unless" - "return"] form] + "return"] + form] ;; Simple default, which covers 99% of the cases. symbolp form))) (if (not (memq t (mapcar #'symbolp @@ -1136,7 +1137,8 @@ (if end (push (list (if down (if excl '> '>=) (if excl '< '<=)) - var (or end-var end)) cl--loop-body)) + var (or end-var end)) + cl--loop-body)) (push (list var (list (if down '- '+) var (or step-var step 1))) loop-for-steps))) @@ -1194,7 +1196,8 @@ (push (list temp-vec (pop cl--loop-args)) loop-for-bindings) (push (list temp-idx -1) loop-for-bindings) (push `(< (setq ,temp-idx (1+ ,temp-idx)) - (length ,temp-vec)) cl--loop-body) + (length ,temp-vec)) + cl--loop-body) (if (eq word 'across-ref) (push (list var `(aref ,temp-vec ,temp-idx)) cl--loop-symbol-macs) @@ -1370,7 +1373,8 @@ (if loop-for-sets (push `(progn ,(cl--loop-let (nreverse loop-for-sets) 'setq ands) - t) cl--loop-body)) + t) + cl--loop-body)) (if loop-for-steps (push (cons (if ands 'cl-psetq 'setq) (apply 'append (nreverse loop-for-steps))) @@ -1388,7 +1392,8 @@ (push `(progn (push ,what ,var) t) cl--loop-body) (push `(progn (setq ,var (nconc ,var (list ,what))) - t) cl--loop-body)))) + t) + cl--loop-body)))) ((memq word '(nconc nconcing append appending)) (let ((what (pop cl--loop-args)) @@ -1403,7 +1408,9 @@ ,var) `(,(if (memq word '(nconc nconcing)) #'nconc #'append) - ,var ,what))) t) cl--loop-body))) + ,var ,what))) + t) + cl--loop-body))) ((memq word '(concat concating)) (let ((what (pop cl--loop-args)) @@ -1434,7 +1441,8 @@ (set `(setq ,var (if ,var (,func ,var ,temp) ,temp)))) (push `(progn ,(if (eq temp what) set `(let ((,temp ,what)) ,set)) - t) cl--loop-body))) + t) + cl--loop-body))) ((eq word 'with) (let ((bindings nil)) @@ -1505,7 +1513,8 @@ (or cl--loop-result-var (setq cl--loop-result-var (make-symbol "--cl-var--"))) (push `(setq ,cl--loop-result-var ,(pop cl--loop-args) - ,cl--loop-finish-flag nil) cl--loop-body)) + ,cl--loop-finish-flag nil) + cl--loop-body)) (t ;; This is an advertised interface: (info "(cl)Other Clauses"). @@ -2398,7 +2407,8 @@ pred-form pred-check) (if (stringp (car descs)) (push `(put ',name 'structure-documentation - ,(pop descs)) forms)) + ,(pop descs)) + forms)) (setq descs (cons '(cl-tag-slot) (mapcar (function (lambda (x) (if (consp x) x (list x)))) descs))) @@ -2551,7 +2561,8 @@ (progn (push `(cl-defsubst ,predicate (cl-x) ,(if (eq (car pred-form) 'and) (append pred-form '(t)) - `(and ,pred-form t))) forms) + `(and ,pred-form t))) + forms) (push (cons predicate 'error-free) side-eff))) (and copier (progn (push `(defun ,copier (x) (copy-sequence x)) forms) @@ -2568,7 +2579,8 @@ slots defaults))) (push `(cl-defsubst ,name (&cl-defs '(nil ,@descs) ,@args) - (,type ,@make)) forms) + (,type ,@make)) + forms) (if (cl--safe-expr-p `(progn ,@(mapcar #'cl-second descs))) (push (cons name t) side-eff)))) (if print-auto (nconc print-func (list '(princ ")" cl-s) t))) @@ -2673,7 +2685,7 @@ (cdr type)))) ((memq (car type) '(member cl-member)) `(and (cl-member ,val ',(cdr type)) t)) - ((eq (car type) 'satisfies) (list (cadr type) val)) + ((eq (car type) 'satisfies) `(funcall #',(cadr type) ,val)) (t (error "Bad type spec: %s" type))))) (defvar cl--object) === modified file 'lisp/emacs-lisp/eieio-base.el' --- lisp/emacs-lisp/eieio-base.el 2014-01-01 07:43:34 +0000 +++ lisp/emacs-lisp/eieio-base.el 2014-10-17 05:09:24 +0000 @@ -1,4 +1,4 @@ -;;; eieio-base.el --- Base classes for EIEIO. +;;; eieio-base.el --- Base classes for EIEIO. -*- lexical-binding:t -*- ;;; Copyright (C) 2000-2002, 2004-2005, 2007-2014 Free Software ;;; Foundation, Inc. @@ -31,7 +31,7 @@ ;;; Code: (require 'eieio) -(eval-when-compile (require 'cl)) ;FIXME: Use cl-lib! +(eval-when-compile (require 'cl-lib)) ;;; eieio-instance-inheritor ;; @@ -52,7 +52,8 @@ not been set, use values from the parent." :abstract t) -(defmethod slot-unbound ((object eieio-instance-inheritor) class slot-name fn) +(defmethod slot-unbound ((object eieio-instance-inheritor) + _class slot-name _fn) "If a slot OBJECT in this CLASS is unbound, try to inherit, or throw a signal. SLOT-NAME is the offending slot. FN is the function signaling the error." (if (slot-boundp object 'parent-instance) @@ -118,7 +119,7 @@ :abstract t) (defmethod initialize-instance :AFTER ((this eieio-instance-tracker) - &rest slots) + &rest _slots) "Make sure THIS is in our master list of this class. Optional argument SLOTS are the initialization arguments." ;; Theoretically, this is never called twice for a given instance. @@ -154,7 +155,7 @@ A singleton is a class which will only ever have one instance." :abstract t) -(defmethod constructor :STATIC ((class eieio-singleton) name &rest slots) +(defmethod constructor :STATIC ((class eieio-singleton) _name &rest _slots) "Constructor for singleton CLASS. NAME and SLOTS initialize the new object. This constructor guarantees that no matter how many you request, === modified file 'lisp/emacs-lisp/eieio-core.el' --- lisp/emacs-lisp/eieio-core.el 2014-01-01 07:43:34 +0000 +++ lisp/emacs-lisp/eieio-core.el 2014-10-17 05:09:24 +0000 @@ -1,4 +1,4 @@ -;;; eieio-core.el --- Core implementation for eieio +;;; eieio-core.el --- Core implementation for eieio -*- lexical-binding:t -*- ;; Copyright (C) 1995-1996, 1998-2014 Free Software Foundation, Inc. @@ -31,7 +31,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) ;FIXME: Use cl-lib! +(require 'cl-lib) ;; Compatibility (if (fboundp 'compiled-function-arglist) @@ -408,6 +408,12 @@ (when (eq (car-safe (symbol-function cname)) 'autoload) (load-library (car (cdr (symbol-function cname)))))) +(cl-deftype list-of (elem-type) + `(and list + (satisfies (lambda (list) + (cl-every (lambda (elem) (cl-typep elem ',elem-type)) + list))))) + (defun eieio-defclass (cname superclasses slots options-and-doc) ;; FIXME: Most of this should be moved to the `defclass' macro. "Define CNAME as a new subclass of SUPERCLASSES. @@ -476,7 +482,7 @@ (setf (eieio--class-children (class-v (car pname))) (cons cname (eieio--class-children (class-v (car pname)))))) ;; Get custom groups, and store them into our local copy. - (mapc (lambda (g) (pushnew g groups :test #'equal)) + (mapc (lambda (g) (cl-pushnew g groups :test #'equal)) (class-option (car pname) :custom-groups)) ;; save parent in child (setf (eieio--class-parent newc) (cons (car pname) (eieio--class-parent newc)))) @@ -553,8 +559,7 @@ ;; test, so we can let typep have the CLOS documented behavior ;; while keeping our above predicate clean. - ;; It would be cleaner to use `defsetf' here, but that requires cl - ;; at runtime. + ;; FIXME: It would be cleaner to use `cl-deftype' here. (put cname 'cl-deftype-handler (list 'lambda () `(list 'satisfies (quote ,csym))))) @@ -655,7 +660,7 @@ prot initarg alloc 'defaultoverride skip-nil) ;; We need to id the group, and store them in a group list attribute. - (mapc (lambda (cg) (pushnew cg groups :test 'equal)) customg) + (mapc (lambda (cg) (cl-pushnew cg groups :test 'equal)) customg) ;; Anyone can have an accessor function. This creates a function ;; of the specified name, and also performs a `defsetf' if applicable @@ -721,7 +726,7 @@ (setf (eieio--class-public-d newc) (nreverse (eieio--class-public-d newc))) (setf (eieio--class-public-doc newc) (nreverse (eieio--class-public-doc newc))) (setf (eieio--class-public-type newc) - (apply 'vector (nreverse (eieio--class-public-type newc)))) + (apply #'vector (nreverse (eieio--class-public-type newc)))) (setf (eieio--class-public-custom newc) (nreverse (eieio--class-public-custom newc))) (setf (eieio--class-public-custom-label newc) (nreverse (eieio--class-public-custom-label newc))) (setf (eieio--class-public-custom-group newc) (nreverse (eieio--class-public-custom-group newc))) @@ -732,11 +737,11 @@ ;; The storage for class-class-allocation-type needs to be turned into ;; a vector now. (setf (eieio--class-class-allocation-type newc) - (apply 'vector (eieio--class-class-allocation-type newc))) + (apply #'vector (eieio--class-class-allocation-type newc))) ;; Also, take class allocated values, and vectorize them for speed. (setf (eieio--class-class-allocation-values newc) - (apply 'vector (eieio--class-class-allocation-values newc))) + (apply #'vector (eieio--class-class-allocation-values newc))) ;; Attach slot symbols into an obarray, and store the index of ;; this slot as the variable slot in this new symbol. We need to @@ -779,7 +784,7 @@ (fset cname `(lambda (newname &rest slots) ,(format "Create a new object with name NAME of class type %s" cname) - (apply 'constructor ,cname newname slots))) + (apply #'constructor ,cname newname slots))) ) ;; Set up a specialized doc string. @@ -798,7 +803,7 @@ ;; We have a list of custom groups. Store them into the options. (let ((g (class-option-assoc options :custom-groups))) - (mapc (lambda (cg) (pushnew cg g :test 'equal)) groups) + (mapc (lambda (cg) (cl-pushnew cg g :test 'equal)) groups) (if (memq :custom-groups options) (setcar (cdr (memq :custom-groups options)) g) (setq options (cons :custom-groups (cons g options))))) @@ -1065,7 +1070,7 @@ )) )) -(defun eieio-copy-parents-into-subclass (newc parents) +(defun eieio-copy-parents-into-subclass (newc _parents) "Copy into NEWC the slots of PARENTS. Follow the rules of not overwriting early parents when applying to the new child class." @@ -1178,6 +1183,8 @@ (let ((doc-string (documentation method))) (fset method (eieio-defgeneric-form-primary-only method doc-string)))) +(declare-function no-applicable-method "eieio" (object method &rest args)) + (defun eieio-defgeneric-form-primary-only-one (method doc-string class impl @@ -1212,7 +1219,7 @@ ',class))) ;; If not the right kind of object, call no applicable - (apply 'no-applicable-method (car local-args) + (apply #'no-applicable-method (car local-args) ',method local-args) ;; It is ok, do the call. @@ -1299,53 +1306,12 @@ ;; This is a hideous hack for replacing `typep' from cl-macs, to avoid ;; requiring the CL library at run-time. It can be eliminated if/when ;; `typep' is merged into Emacs core. -(defun eieio--typep (val type) - (if (symbolp type) - (cond ((get type 'cl-deftype-handler) - (eieio--typep val (funcall (get type 'cl-deftype-handler)))) - ((eq type t) t) - ((eq type 'null) (null val)) - ((eq type 'atom) (atom val)) - ((eq type 'float) (and (numberp val) (not (integerp val)))) - ((eq type 'real) (numberp val)) - ((eq type 'fixnum) (integerp val)) - ((memq type '(character string-char)) (characterp val)) - (t - (let* ((name (symbol-name type)) - (namep (intern (concat name "p")))) - (if (fboundp namep) - (funcall `(lambda () (,namep val))) - (funcall `(lambda () - (,(intern (concat name "-p")) val))))))) - (cond ((get (car type) 'cl-deftype-handler) - (eieio--typep val (apply (get (car type) 'cl-deftype-handler) - (cdr type)))) - ((memq (car type) '(integer float real number)) - (and (eieio--typep val (car type)) - (or (memq (cadr type) '(* nil)) - (if (consp (cadr type)) - (> val (car (cadr type))) - (>= val (cadr type)))) - (or (memq (caddr type) '(* nil)) - (if (consp (car (cddr type))) - (< val (caar (cddr type))) - (<= val (car (cddr type))))))) - ((memq (car type) '(and or not)) - (eval (cons (car type) - (mapcar (lambda (x) - `(eieio--typep (quote ,val) (quote ,x))) - (cdr type))))) - ((memq (car type) '(member member*)) - (memql val (cdr type))) - ((eq (car type) 'satisfies) - (funcall `(lambda () (,(cadr type) val)))) - (t (error "Bad type spec: %s" type))))) (defun eieio-perform-slot-validation (spec value) "Return non-nil if SPEC does not match VALUE." (or (eq spec t) ; t always passes (eq value eieio-unbound) ; unbound always passes - (eieio--typep value spec))) + (cl-typep value spec))) (defun eieio-validate-slot-value (class slot-idx value slot) "Make sure that for CLASS referencing SLOT-IDX, VALUE is valid. @@ -1632,7 +1598,7 @@ ;; applicable. (eieio-c3-merge-lists (cons next reversed-partial-result) - (mapcar (lambda (l) (if (eq (first l) next) (rest l) l)) + (mapcar (lambda (l) (if (eq (cl-first l) next) (cl-rest l) l)) remaining-inputs)) ;; The graph is inconsistent, give up (signal 'inconsistent-class-hierarchy (list remaining-inputs)))))) @@ -1700,7 +1666,7 @@ method invocation orders of the involved classes." (if (or (null class) (eq class 'eieio-default-superclass)) nil - (case (class-method-invocation-order class) + (cl-case (class-method-invocation-order class) (:depth-first (eieio-class-precedence-dfs class)) (:breadth-first @@ -1839,7 +1805,7 @@ ;; Now loop through all occurrences forms which we must execute ;; (which are happily sorted now) and execute them all! - (let ((rval nil) (lastval nil) (rvalever nil) (found nil)) + (let ((rval nil) (lastval nil) (found nil)) (while lambdas (if (car lambdas) (eieio--with-scoped-class (cdr (car lambdas)) @@ -1856,20 +1822,16 @@ ;;(setq rval (apply (car (car lambdas)) newargs)) (setq lastval (apply (car (car lambdas)) newargs)) (when has-return-val - (setq rval lastval - rvalever t)) + (setq rval lastval)) ))) (setq lambdas (cdr lambdas) keys (cdr keys))) (if (not found) (if (eieio-object-p (car args)) - (setq rval (apply 'no-applicable-method (car args) method args) - rvalever t) + (setq rval (apply #'no-applicable-method (car args) method args)) (signal 'no-method-definition (list method args)))) - ;; Right Here... it could be that lastval is returned when - ;; rvalever is nil. Is that right? rval))) (defun eieio-generic-call-primary-only (method args) @@ -1920,7 +1882,7 @@ ;; Now loop through all occurrences forms which we must execute ;; (which are happily sorted now) and execute them all! (eieio--with-scoped-class (cdr lambdas) - (let* ((rval nil) (lastval nil) (rvalever nil) + (let* ((rval nil) (lastval nil) (eieio-generic-call-key method-primary) ;; Use the cdr, as the first element is the fcn ;; we are calling right now. @@ -1931,8 +1893,8 @@ ;; No methods found for this impl... (if (eieio-object-p (car args)) - (setq rval (apply 'no-applicable-method (car args) method args) - rvalever t) + (setq rval (apply #'no-applicable-method + (car args) method args)) (signal 'no-method-definition (list method args))) @@ -1943,12 +1905,8 @@ lambdas) (setq lastval (apply (car lambdas) newargs)) - (setq rval lastval - rvalever t) - ) + (setq rval lastval)) - ;; Right Here... it could be that lastval is returned when - ;; rvalever is nil. Is that right? rval)))) (defun eieiomt-method-list (method key class) @@ -2054,7 +2012,7 @@ (when (string-match "\\.elc$" fname) (setq fname (substring fname 0 (1- (length fname))))) (setq loc (get method-name 'method-locations)) - (pushnew (list class fname) loc :test 'equal) + (cl-pushnew (list class fname) loc :test 'equal) (put method-name 'method-locations loc))) ;; Now optimize the entire obarray (if (< key method-num-lists) @@ -2084,7 +2042,8 @@ ;; we replace the nil from above. (let ((external-symbol (intern-soft (symbol-name s)))) (catch 'done - (dolist (ancestor (rest (eieio-class-precedence-list external-symbol))) + (dolist (ancestor + (cl-rest (eieio-class-precedence-list external-symbol))) (let ((ov (intern-soft (symbol-name ancestor) eieiomt-optimizing-obarray))) (when (fboundp ov) === modified file 'lisp/emacs-lisp/eieio.el' --- lisp/emacs-lisp/eieio.el 2014-05-26 10:21:18 +0000 +++ lisp/emacs-lisp/eieio.el 2014-10-17 05:09:24 +0000 @@ -1,4 +1,4 @@ -;;; eieio.el --- Enhanced Implementation of Emacs Interpreted Objects +;;; eieio.el --- Enhanced Implementation of Emacs Interpreted Objects -*- lexical-binding:t -*- ;;; or maybe Eric's Implementation of Emacs Interpreted Objects ;; Copyright (C) 1995-1996, 1998-2014 Free Software Foundation, Inc. @@ -44,8 +44,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) ;FIXME: Use cl-lib! - (defvar eieio-version "1.4" "Current version of EIEIO.") @@ -115,6 +113,7 @@ Due to the way class options are set up, you can add any tags you wish, and reference them using the function `class-option'." + (declare (doc-string 4)) ;; This is eval-and-compile only to silence spurious compiler warnings ;; about functions and variables not known to be defined. ;; When eieio-defclass code is merged here and this becomes @@ -155,7 +154,7 @@ ;;; CLOS methods and generics ;; -(defmacro defgeneric (method args &optional doc-string) +(defmacro defgeneric (method _args &optional doc-string) "Create a generic function METHOD. DOC-STRING is the base documentation for this class. A generic function has no body, as its purpose is to decide which method body @@ -163,6 +162,7 @@ `defgeneric' for you. With this implementation the ARGS are currently ignored. You can use `defgeneric' to apply specialized top level documentation to a method." + (declare (doc-string 3)) `(eieio--defalias ',method (eieio--defgeneric-init-form ',method ,doc-string))) @@ -191,6 +191,7 @@ ((typearg class-name) arg2 &optional opt &rest rest) \"doc-string\" body)" + (declare (doc-string 3)) (let* ((key (if (keywordp (car args)) (pop args))) (params (car args)) (arg1 (car params)) @@ -246,6 +247,7 @@ SLOT. A slot specified without a variable name is given a variable name of the same name as the slot." (declare (indent 2)) + (require 'cl-lib) ;; Transform the spec-list into a cl-symbol-macrolet spec-list. (let ((mappings (mapcar (lambda (entry) (let ((var (if (listp entry) (car entry) entry)) @@ -523,7 +525,7 @@ (next (car eieio-generic-call-next-method-list)) ) (if (or (not next) (not (car next))) - (apply 'no-next-method (car newargs) (cdr newargs)) + (apply #'no-next-method (car newargs) (cdr newargs)) (let* ((eieio-generic-call-next-method-list (cdr eieio-generic-call-next-method-list)) (eieio-generic-call-arglst newargs) @@ -535,27 +537,7 @@ ;;; Here are some CLOS items that need the CL package ;; -(defsetf eieio-oref eieio-oset) - -(if (eval-when-compile (fboundp 'gv-define-expander)) - ;; Not needed for Emacs>=24.3 since gv.el's setf expands macros and - ;; follows aliases. - nil -(defsetf slot-value eieio-oset) - -;; The below setf method was written by Arnd Kohrs -(define-setf-method oref (obj slot) - (with-no-warnings - (require 'cl) - (let ((obj-temp (gensym)) - (slot-temp (gensym)) - (store-temp (gensym))) - (list (list obj-temp slot-temp) - (list obj `(quote ,slot)) - (list store-temp) - (list 'set-slot-value obj-temp slot-temp - store-temp) - (list 'slot-value obj-temp slot-temp)))))) +(gv-define-simple-setter eieio-oref eieio-oset) ;;; @@ -651,7 +633,7 @@ "Method invoked when an attempt to access a slot in OBJECT fails.") (defmethod slot-missing ((object eieio-default-superclass) slot-name - operation &optional new-value) + _operation &optional _new-value) "Method invoked when an attempt to access a slot in OBJECT fails. SLOT-NAME is the name of the failed slot, OPERATION is the type of access that was requested, and optional NEW-VALUE is the value that was desired @@ -684,7 +666,7 @@ "Called if there are no implementations for OBJECT in METHOD.") (defmethod no-applicable-method ((object eieio-default-superclass) - method &rest args) + method &rest _args) "Called if there are no implementations for OBJECT in METHOD. OBJECT is the object which has no method implementation. ARGS are the arguments that were passed to METHOD. @@ -734,7 +716,7 @@ (defgeneric destructor (this &rest params) "Destructor for cleaning up any dynamic links to our object.") -(defmethod destructor ((this eieio-default-superclass) &rest params) +(defmethod destructor ((_this eieio-default-superclass) &rest _params) "Destructor for cleaning up any dynamic links to our object. Argument THIS is the object being destroyed. PARAMS are additional ignored parameters." @@ -760,7 +742,7 @@ `call-next-method' to provide additional summary information. When passing in extra strings from child classes, always remember to prepend a space." - (eieio-object-name this (apply 'concat strings))) + (eieio-object-name this (apply #'concat strings))) (defvar eieio-print-depth 0 "When printing, keep track of the current indentation depth.") @@ -859,7 +841,7 @@ ;;; Unimplemented functions from CLOS ;; -(defun change-class (obj class) +(defun change-class (_obj _class) "Change the class of OBJ to type CLASS. This may create or delete slots, but does not affect the return value of `eq'." @@ -879,7 +861,8 @@ ((eieio-object-p object) (object-print object)) ((and (listp object) (or (class-p (car object)) (eieio-object-p (car object)))) - (concat "(" (mapconcat 'eieio-edebug-prin1-to-string object " ") ")")) + (concat "(" (mapconcat #'eieio-edebug-prin1-to-string object " ") + ")")) (t (prin1-to-string object noescape)))) (add-hook 'edebug-setup-hook ------------------------------------------------------------ revno: 118137 author: Jorge A. Alfaro Murillo committer: Katsumi Yamaoka branch nick: trunk timestamp: Thu 2014-10-16 22:12:47 +0000 message: lisp/gnus/message.el (message-insert-signature): Make signature respect format=flowed diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2014-10-16 22:12:03 +0000 +++ lisp/gnus/ChangeLog 2014-10-16 22:12:47 +0000 @@ -1,3 +1,8 @@ +2014-10-15 Jorge A. Alfaro-Murillo (tiny change) + + * message.el (message-insert-signature): Use `newline' instead of + inserting explicit "\n". + 2014-10-15 Sylvain Chouleur * gnus-icalendar.el: Support vcal format timezones === modified file 'lisp/gnus/message.el' --- lisp/gnus/message.el 2014-09-29 18:14:08 +0000 +++ lisp/gnus/message.el 2014-10-16 22:12:47 +0000 @@ -3531,15 +3531,16 @@ (goto-char (point-max)) ;; Insert the signature. (unless (bolp) - (insert "\n")) + (newline)) (when message-signature-insert-empty-line - (insert "\n")) - (insert "-- \n") + (newline)) + (insert "-- ") + (newline) (if (eq signature t) (insert-file-contents signature-file) (insert signature)) (goto-char (point-max)) - (or (bolp) (insert "\n"))))) + (or (bolp) (newline))))) (defun message-insert-importance-high () "Insert header to mark message as important." ------------------------------------------------------------ revno: 118136 author: Sylvain Chouleur committer: Katsumi Yamaoka branch nick: trunk timestamp: Thu 2014-10-16 22:12:03 +0000 message: lisp/gnus/gnus-icalendar.el: Support vcal format timezones diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2014-10-14 22:13:44 +0000 +++ lisp/gnus/ChangeLog 2014-10-16 22:12:03 +0000 @@ -1,3 +1,10 @@ +2014-10-15 Sylvain Chouleur + + * gnus-icalendar.el: Support vcal format timezones + (gnus-icalendar-event--decode-datefield): use icalendar functions to + compute dates with associated timezone + (gnus-icalendar-event-from-ical): compute all timezones + 2014-10-14 Teodor Zlatanov * gnus-start.el (gnus-save-newsrc-file-check-timestamp): New option to === modified file 'lisp/gnus/gnus-icalendar.el' --- lisp/gnus/gnus-icalendar.el 2014-10-06 22:11:44 +0000 +++ lisp/gnus/gnus-icalendar.el 2014-10-16 22:12:03 +0000 @@ -141,12 +141,13 @@ (defmethod gnus-icalendar-event:start ((event gnus-icalendar-event)) (format-time-string "%Y-%m-%d %H:%M" (gnus-icalendar-event:start-time event))) -(defun gnus-icalendar-event--decode-datefield (ical field) - (let* ((date (icalendar--get-event-property ical field)) - (date-props (icalendar--get-event-property-attributes ical field)) - (tz (plist-get date-props 'TZID))) - - (date-to-time (timezone-make-date-arpa-standard date nil tz)))) +(defun gnus-icalendar-event--decode-datefield (event field zone-map) + (let* ((dtdate (icalendar--get-event-property event field)) + (dtdate-zone (icalendar--find-time-zone + (icalendar--get-event-property-attributes + event field) zone-map)) + (dtdate-dec (icalendar--decode-isodatetime dtdate nil dtdate-zone))) + (apply 'encode-time dtdate-dec))) (defun gnus-icalendar-event--find-attendee (ical name-or-email) (let* ((event (car (icalendar--all-events ical))) @@ -204,10 +205,11 @@ ("REQ-PARTICIPANT" 'required) ("OPT-PARTICIPANT" 'optional) (_ 'non-participant))) + (zone-map (icalendar--convert-all-timezones ical)) (args (list :method method :organizer organizer - :start-time (gnus-icalendar-event--decode-datefield event 'DTSTART) - :end-time (gnus-icalendar-event--decode-datefield event 'DTEND) + :start-time (gnus-icalendar-event--decode-datefield event 'DTSTART zone-map) + :end-time (gnus-icalendar-event--decode-datefield event 'DTEND zone-map) :rsvp (string= (plist-get (cadr attendee) 'RSVP) "TRUE") :participation-type participation-type :req-participants (car attendee-names) ------------------------------------------------------------ revno: 118135 committer: Alan Mackenzie branch nick: trunk timestamp: Thu 2014-10-16 20:29:44 +0000 message: Trigger showing when point is in the "periphery" of a line or just inside a paren. paren.el (show-paren-style, show-paren-delay) (show-paren-priority, show-paren-ring-bell-on-mismatch): Remove superfluous :group specifications. (show-paren-when-point-inside-paren) (show-paren-when-point-in-periphery): New customizable variables. (show-paren-highlight-openparen): Make into a defcustom. (show-paren--unescaped-p, show-paren--categorize-paren) (show-paren--locate-near-paren): New defuns. (show-paren--default): Refaactor and trigger on more paren positions. (show-paren-function): Small consequential changes. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-16 19:56:43 +0000 +++ lisp/ChangeLog 2014-10-16 20:29:44 +0000 @@ -1,3 +1,19 @@ +2014-10-16 Alan Mackenzie + + Trigger showing when point is in the "periphery" of a line or just + inside a paren. + * paren.el (show-paren-style, show-paren-delay) + (show-paren-priority, show-paren-ring-bell-on-mismatch): Remove + superfluous :group specifications. + (show-paren-when-point-inside-paren) + (show-paren-when-point-in-periphery): New customizable variables. + (show-paren-highlight-openparen): Make into a defcustom. + (show-paren--unescaped-p, show-paren--categorize-paren) + (show-paren--locate-near-paren): New defuns. + (show-paren--default): Refaactor and trigger on more paren + positions. + (show-paren-function): Small consequential changes. + 2014-10-16 Tom Tromey * files.el (auto-mode-alist): Use javascript-mode for .jsm === modified file 'lisp/paren.el' --- lisp/paren.el 2014-02-10 01:34:22 +0000 +++ lisp/paren.el 2014-10-16 20:29:44 +0000 @@ -43,8 +43,7 @@ `expression' (meaning show the entire expression enclosed by the paren) and `mixed' (meaning show the matching paren if it is visible, and the expression otherwise)." - :type '(choice (const parenthesis) (const expression) (const mixed)) - :group 'paren-showing) + :type '(choice (const parenthesis) (const expression) (const mixed))) (defcustom show-paren-delay 0.125 "Time in seconds to delay before showing a matching paren. @@ -57,28 +56,39 @@ (set sym val) (show-paren-mode -1) (set sym val) - (show-paren-mode 1))) - :group 'paren-showing) + (show-paren-mode 1)))) (defcustom show-paren-priority 1000 "Priority of paren highlighting overlays." - :type 'integer - :group 'paren-showing + :type 'integer :version "21.1") (defcustom show-paren-ring-bell-on-mismatch nil "If non-nil, beep if mismatched paren is detected." :type 'boolean - :group 'paren-showing :version "20.3") +(defcustom show-paren-when-point-inside-paren nil + "If non-nil, show parens when point is just inside one. +This will only be done when point isn't also just outside a paren." + :type 'boolean + :version "25.1") + +(defcustom show-paren-when-point-in-periphery nil + "If non-nil, show parens when point is in the line's periphery. +The periphery is at the beginning or end of a line or in any +whitespace there." + :type 'boolean + :version "25.1") + (define-obsolete-face-alias 'show-paren-match-face 'show-paren-match "22.1") (define-obsolete-face-alias 'show-paren-mismatch-face 'show-paren-mismatch "22.1") -(defvar show-paren-highlight-openparen t - "Non-nil turns on openparen highlighting when matching forward.") +(defcustom show-paren-highlight-openparen t + "Non-nil turns on openparen highlighting when matching forward." + :type 'boolean) (defvar show-paren--idle-timer nil) (defvar show-paren--overlay @@ -112,76 +122,113 @@ (delete-overlay show-paren--overlay) (delete-overlay show-paren--overlay-1))) +(defun show-paren--unescaped-p (pos) + "Determine whether the paren after POS is unescaped." + (save-excursion + (goto-char pos) + (= (logand (skip-syntax-backward "/\\") 1) 0))) + +(defun show-paren--categorize-paren (pos) + "Determine whether the character after POS has paren syntax, +and if so, return a cons (DIR . OUTSIDE), where DIR is 1 for an +open paren, -1 for a close paren, and OUTSIDE is the buffer +position of the outside of the paren. If the character isn't a +paren, or it is an escaped paren, return nil." + (cond + ((and (eq (syntax-class (syntax-after pos)) 4) + (show-paren--unescaped-p pos)) + (cons 1 pos)) + ((and (eq (syntax-class (syntax-after pos)) 5) + (show-paren--unescaped-p pos)) + (cons -1 (1+ pos))))) + +(defun show-paren--locate-near-paren () + "Locate an unescaped paren \"near\" point to show. +If one is found, return the cons (DIR . OUTSIDE), where DIR is 1 +for an open paren, -1 for a close paren, and OUTSIDE is the buffer +position of the outside of the paren. Otherwise return nil." + (let* ((ind-pos (save-excursion (back-to-indentation) (point))) + (eol-pos + (save-excursion + (end-of-line) (skip-chars-backward " \t" ind-pos) (point))) + (before (show-paren--categorize-paren (1- (point)))) + (after (show-paren--categorize-paren (point)))) + (cond + ;; Point is immediately outside a paren. + ((eq (car before) -1) before) + ((eq (car after) 1) after) + ;; Point is immediately inside a paren. + ((and show-paren-when-point-inside-paren before)) + ((and show-paren-when-point-inside-paren after)) + ;; Point is in the whitespace before the code. + ((and show-paren-when-point-in-periphery + (<= (point) ind-pos)) + (or (show-paren--categorize-paren ind-pos) + (show-paren--categorize-paren (1- eol-pos)))) + ;; Point is in the whitespace after the code. + ((and show-paren-when-point-in-periphery + (>= (point) eol-pos)) + (show-paren--categorize-paren (1- eol-pos)))))) + (defvar show-paren-data-function #'show-paren--default - "Function to find the opener/closer at point and its match. + "Function to find the opener/closer \"near\" point and its match. The function is called with no argument and should return either nil -if there's no opener/closer at point, or a list of the form +if there's no opener/closer near point, or a list of the form \(HERE-BEG HERE-END THERE-BEG THERE-END MISMATCH) -Where HERE-BEG..HERE-END is expected to be around point.") +Where HERE-BEG..HERE-END is expected to be near point.") (defun show-paren--default () - (let* ((oldpos (point)) - (dir (cond ((eq (syntax-class (syntax-after (1- (point)))) 5) -1) - ((eq (syntax-class (syntax-after (point))) 4) 1))) - (unescaped - (when dir - ;; Verify an even number of quoting characters precede the paren. - ;; Follow the same logic as in `blink-matching-open'. - (= (if (= dir -1) 1 0) - (logand 1 (- (point) - (save-excursion - (if (= dir -1) (forward-char -1)) - (skip-syntax-backward "/\\") - (point))))))) - (here-beg (if (eq dir 1) (point) (1- (point)))) - (here-end (if (eq dir 1) (1+ (point)) (point))) - pos mismatch) + (let* ((temp (show-paren--locate-near-paren)) + (dir (car temp)) + (outside (cdr temp)) + pos mismatch here-beg here-end) ;; ;; Find the other end of the sexp. - (when unescaped - (save-excursion - (save-restriction - ;; Determine the range within which to look for a match. - (when blink-matching-paren-distance - (narrow-to-region - (max (point-min) (- (point) blink-matching-paren-distance)) - (min (point-max) (+ (point) blink-matching-paren-distance)))) - ;; Scan across one sexp within that range. - ;; Errors or nil mean there is a mismatch. - (condition-case () - (setq pos (scan-sexps (point) dir)) - (error (setq pos t mismatch t))) - ;; Move back the other way and verify we get back to the - ;; starting point. If not, these two parens don't really match. - ;; Maybe the one at point is escaped and doesn't really count, - ;; or one is inside a comment. - (when (integerp pos) - (unless (condition-case () - (eq (point) (scan-sexps pos (- dir))) - (error nil)) - (setq pos nil))) - ;; If found a "matching" paren, see if it is the right - ;; kind of paren to match the one we started at. - (if (not (integerp pos)) - (if mismatch (list here-beg here-end nil nil t)) - (let ((beg (min pos oldpos)) (end (max pos oldpos))) - (unless (eq (syntax-class (syntax-after beg)) 8) - (setq mismatch - (not (or (eq (char-before end) - ;; This can give nil. - (cdr (syntax-after beg))) - (eq (char-after beg) - ;; This can give nil. - (cdr (syntax-after (1- end)))) - ;; The cdr might hold a new paren-class - ;; info rather than a matching-char info, - ;; in which case the two CDRs should match. - (eq (cdr (syntax-after (1- end))) - (cdr (syntax-after beg))))))) - (list here-beg here-end - (if (= dir 1) (1- pos) pos) - (if (= dir 1) pos (1+ pos)) - mismatch)))))))) + (when dir + (setq here-beg (if (eq dir 1) outside (1- outside)) + here-end (if (eq dir 1) (1+ outside) outside)) + (save-restriction + ;; Determine the range within which to look for a match. + (when blink-matching-paren-distance + (narrow-to-region + (max (point-min) (- (point) blink-matching-paren-distance)) + (min (point-max) (+ (point) blink-matching-paren-distance)))) + ;; Scan across one sexp within that range. + ;; Errors or nil mean there is a mismatch. + (condition-case () + (setq pos (scan-sexps outside dir)) + (error (setq pos t mismatch t))) + ;; Move back the other way and verify we get back to the + ;; starting point. If not, these two parens don't really match. + ;; Maybe the one at point is escaped and doesn't really count, + ;; or one is inside a comment. + (when (integerp pos) + (unless (condition-case () + (eq outside (scan-sexps pos (- dir))) + (error nil)) + (setq pos nil))) + ;; If found a "matching" paren, see if it is the right + ;; kind of paren to match the one we started at. + (if (not (integerp pos)) + (if mismatch (list here-beg here-end nil nil t)) + (let ((beg (min pos outside)) (end (max pos outside))) + (unless (eq (syntax-class (syntax-after beg)) 8) + (setq mismatch + (not (or (eq (char-before end) + ;; This can give nil. + (cdr (syntax-after beg))) + (eq (char-after beg) + ;; This can give nil. + (cdr (syntax-after (1- end)))) + ;; The cdr might hold a new paren-class + ;; info rather than a matching-char info, + ;; in which case the two CDRs should match. + (eq (cdr (syntax-after (1- end))) + (cdr (syntax-after beg))))))) + (list here-beg here-end + (if (= dir 1) (1- pos) pos) + (if (= dir 1) pos (1+ pos)) + mismatch))))))) ;; Find the place to show, if there is one, ;; and show it until input arrives. @@ -215,7 +262,8 @@ ;; Otherwise, turn off any such highlighting. (if (or (not here-beg) (and (not show-paren-highlight-openparen) - (> here-end (point)) + (> here-end (point)) + (<= here-beg (point)) (integerp there-beg))) (delete-overlay show-paren--overlay-1) (move-overlay show-paren--overlay-1 @@ -234,7 +282,7 @@ (1- there-end) (1+ there-beg)))) (not (pos-visible-in-window-p closest))))) (move-overlay show-paren--overlay - (point) + (if (< there-beg here-beg) here-end here-beg) (if (< there-beg here-beg) there-beg there-end) (current-buffer)) (move-overlay show-paren--overlay ------------------------------------------------------------ revno: 118134 committer: Tom Tromey branch nick: trunk timestamp: Thu 2014-10-16 13:56:43 -0600 message: * files.el (auto-mode-alist): Use javascript-mode for .jsm (bug #18719). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-16 16:42:59 +0000 +++ lisp/ChangeLog 2014-10-16 19:56:43 +0000 @@ -1,3 +1,8 @@ +2014-10-16 Tom Tromey + + * files.el (auto-mode-alist): Use javascript-mode for .jsm + (bug #18719). + 2014-10-16 Eli Zaretskii * international/characters.el (bracket-type): Force pre-loading of === modified file 'lisp/files.el' --- lisp/files.el 2014-10-04 07:27:10 +0000 +++ lisp/files.el 2014-10-16 19:56:43 +0000 @@ -2413,7 +2413,7 @@ ("\\.dbk\\'" . xml-mode) ("\\.dtd\\'" . sgml-mode) ("\\.ds\\(ss\\)?l\\'" . dsssl-mode) - ("\\.js\\'" . javascript-mode) + ("\\.jsm?\\'" . javascript-mode) ("\\.json\\'" . javascript-mode) ("\\.[ds]?vh?\\'" . verilog-mode) ("\\.by\\'" . bovine-grammar-mode) ------------------------------------------------------------ revno: 118133 committer: Eli Zaretskii branch nick: trunk timestamp: Thu 2014-10-16 19:42:59 +0300 message: Pre-load uni-brackets.el, which is always needed for redisplay. lisp/international/characters.el (bracket-type): Force pre-loading of uni-brackets.el. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-16 01:49:34 +0000 +++ lisp/ChangeLog 2014-10-16 16:42:59 +0000 @@ -1,3 +1,8 @@ +2014-10-16 Eli Zaretskii + + * international/characters.el (bracket-type): Force pre-loading of + uni-brackets.el. + 2014-10-16 Alan Mackenzie * cus-edit.el (custom-command-apply): Specify the return value in === modified file 'lisp/international/characters.el' --- lisp/international/characters.el 2014-06-28 01:35:48 +0000 +++ lisp/international/characters.el 2014-10-16 16:42:59 +0000 @@ -495,12 +495,13 @@ (modify-category-entry key ?L)))) table))) -;; Load uni-mirrored.el if available, so that it gets dumped into -;; Emacs. This allows to start Emacs with force-load-messages in -;; ~/.emacs, and avoid infinite recursion in bidi_initialize, which -;; needs to load uni-mirrored.el in order to display the "Loading" -;; messages. +;; Load uni-mirrored.el and uni-brackets.el if available, so that they +;; get dumped into Emacs. This allows to start Emacs with +;; force-load-messages in ~/.emacs, and avoid infinite recursion in +;; bidi_initialize, which needs to load uni-mirrored.el and +;; uni-brackets.el in order to display the "Loading" messages. (unicode-property-table-internal 'mirroring) +(unicode-property-table-internal 'bracket-type) ;; Latin ------------------------------------------------------------ revno: 118132 committer: Eli Zaretskii branch nick: trunk timestamp: Thu 2014-10-16 09:55:34 +0300 message: src/bidi.c (bidi_find_bracket_pairs): Avoid a loop that does nothing useful. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2014-10-15 17:53:04 +0000 +++ src/ChangeLog 2014-10-16 06:55:34 +0000 @@ -1,3 +1,8 @@ +2014-10-16 Eli Zaretskii + + * bidi.c (bidi_find_bracket_pairs): Avoid a loop that does nothing + useful. + 2014-10-15 Paul Eggert * bidi.c (bidi_find_bracket_pairs): Initialize local var. === modified file 'src/bidi.c' --- src/bidi.c 2014-10-15 17:53:04 +0000 +++ src/bidi.c 2014-10-16 06:55:34 +0000 @@ -2472,8 +2472,11 @@ default: break; } - for (sp = bpa_sp; sp >= 0; sp--) - bpa_stack[sp].flags |= flag; + if (flag) + { + for (sp = bpa_sp; sp >= 0; sp--) + bpa_stack[sp].flags |= flag; + } } old_sidx = bidi_it->stack_idx; type = bidi_resolve_weak (bidi_it);