diff options
| author | Paul Eggert <[email protected]> | 2011-08-24 14:20:36 -0700 |
|---|---|---|
| committer | Paul Eggert <[email protected]> | 2011-08-24 14:20:36 -0700 |
| commit | 011ba6eaacfa50cc9871d0cfea34e8f0a7a5bc43 (patch) | |
| tree | ced7a98ff1eb289559da6ebfda46a8e436640da6 | |
| parent | fe4496a6e27ac892283b8568adbd12831868cc54 (diff) | |
| parent | f22f4808a08e8f985d5e6175bbd13d5260e1ab1a (diff) | |
Merge from trunk.
84 files changed, 1307 insertions, 556 deletions
diff --git a/admin/ChangeLog b/admin/ChangeLog index bc38edfc8d..17cbcbb3bd 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,23 @@ +2011-08-23 Eli Zaretskii <[email protected]> + + * unidata/unidata-gen.el (unidata-prop-alist): Update the default + values of bidi-class according to DerivedBidiClass.txt from the + latest UCD. + +2011-08-23 Kenichi Handa <[email protected]> + + * unidata/unidata-gen.el (unidata-prop-alist): Provide default + values for name, general-category, canonical-combining-class, + mirrored, and bidi-class. Describe the meaning of value nil for + decimal-digit-value, digit-value, numeric-value, uppercase, + lowercase, titlecase, and mirroring. + (unidata-gen-table): Handle the case that default-value is a + list. Set default values of characters not listed in a table. + (unidata-get-name): Return an empty string if a value in a + char-table is nil. + (unidata-get-decomposition): Return a list of character itself if + a value in a char-table is nil. + 2011-08-15 Eli Zaretskii <[email protected]> * unidata/bidimirror.awk: File removed. diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el index ab1dcd134a..1002bb003a 100644 --- a/admin/unidata/unidata-gen.el +++ b/admin/unidata/unidata-gen.el @@ -146,7 +146,7 @@ (setq unidata-list (cdr table)))) ;; Alist of this form: -;; (PROP INDEX GENERATOR FILENAME DOCSTRING DESCRIBER VAL-LIST) +;; (PROP INDEX GENERATOR FILENAME DOCSTRING DESCRIBER DEFAULT VAL-LIST) ;; PROP: character property ;; INDEX: index to each element of unidata-list for PROP. ;; It may be a function that generates an alist of character codes @@ -155,14 +155,20 @@ ;; FILENAME: filename to store the char-table ;; DOCSTRING: docstring for the property ;; DESCRIBER: function to call to get a description string of property value -;; DEFAULT: the default value of the property +;; DEFAULT: the default value of the property. It may have the form +;; (VAL0 (FROM1 TO1 VAL1) ...) which indicates that the default +;; value is VAL0 except for characters in the ranges specified by +;; FROMn and TOn (incusive). The default value of characters +;; between FROMn and TOn is VALn. ;; VAL-LIST: list of specially ordered property values (defconst unidata-prop-alist '((name 1 unidata-gen-table-name "uni-name.el" "Unicode character name. -Property value is a string.") +Property value is a string." + nil + "") (general-category 2 unidata-gen-table-symbol "uni-category.el" "Unicode general category. @@ -170,7 +176,7 @@ Property value is one of the following symbols: Lu, Ll, Lt, Lm, Lo, Mn, Mc, Me, Nd, Nl, No, Pc, Pd, Ps, Pe, Pi, Pf, Po, Sm, Sc, Sk, So, Zs, Zl, Zp, Cc, Cf, Cs, Co, Cn" unidata-describe-general-category - nil + Cn ;; The order of elements must be in sync with unicode_category_t ;; in src/character.h. (Lu Ll Lt Lm Lo Mn Mc Me Nd Nl No Pc Pd Ps Pe Pi Pf Po @@ -179,7 +185,8 @@ Property value is one of the following symbols: 3 unidata-gen-table-integer "uni-combining.el" "Unicode canonical combining class. Property value is an integer." - unidata-describe-canonical-combining-class) + unidata-describe-canonical-combining-class + 0) (bidi-class 4 unidata-gen-table-symbol "uni-bidi.el" "Unicode bidi class. @@ -187,7 +194,12 @@ Property value is one of the following symbols: L, LRE, LRO, R, AL, RLE, RLO, PDF, EN, ES, ET, AN, CS, NSM, BN, B, S, WS, ON" unidata-describe-bidi-class - L + ;; The assignment of default values to blocks of code points + ;; follows the file DerivedBidiClass.txt from the Unicode + ;; Character Database (UCD). + (L (#x0600 #x06FF AL) (#xFB50 #xFDFF AL) (#xFE70 #xFEFF AL) + (#x0590 #x05FF R) (#x07C0 #x08FF R) + (#xFB1D #xFB4F R) (#x10800 #x10FFF R) (#x1E800 #x1EFFF R)) ;; The order of elements must be in sync with bidi_type_t in ;; src/dispextern.h. (L R EN AN BN B AL LRE LRO RLE RLO PDF ES ET CS NSM S WS ON)) @@ -202,19 +214,24 @@ one of these symbols representing compatibility formatting tag: (decimal-digit-value 6 unidata-gen-table-integer "uni-decimal.el" "Unicode numeric value (decimal digit). -Property value is an integer.") +Property value is an integer 0..9, or nil. +The value nil stands for NaN \"Numeric_Value\".") (digit-value 7 unidata-gen-table-integer "uni-digit.el" "Unicode numeric value (digit). -Property value is an integer.") +Property value is an integer 0..9, or nil. +The value nil stands for NaN \"Numeric_Value\".") (numeric-value 8 unidata-gen-table-numeric "uni-numeric.el" "Unicode numeric value (numeric). -Property value is an integer or a floating point.") +Property value is an integer, a floating point, or nil. +The value nil stands for NaN \"Numeric_Value\".") (mirrored 9 unidata-gen-table-symbol "uni-mirrored.el" "Unicode bidi mirrored flag. -Property value is a symbol `Y' or `N'. See also the property `mirroring'.") +Property value is a symbol `Y' or `N'. See also the property `mirroring'." + nil + N) (old-name 10 unidata-gen-table-name "uni-old-name.el" "Unicode old names as published in Unicode 1.0. @@ -226,23 +243,30 @@ Property value is a string.") (uppercase 12 unidata-gen-table-character "uni-uppercase.el" "Unicode simple uppercase mapping. -Property value is a character." +Property value is a character or nil. +The value nil means that the actual property value of a character +is the character itself." string) (lowercase 13 unidata-gen-table-character "uni-lowercase.el" "Unicode simple lowercase mapping. -Property value is a character." +Property value is a character or nil. +The value nil means that the actual property value of a character +is the character itself." string) (titlecase 14 unidata-gen-table-character "uni-titlecase.el" "Unicode simple titlecase mapping. -Property value is a character." +Property value is a character or nil. +The value nil means that the actual property value of a character +is the character itself." string) (mirroring unidata-gen-mirroring-list unidata-gen-table-character "uni-mirrored.el" "Unicode bidi-mirroring characters. -Property value is a character that has the corresponding mirroring image, -or nil for non-mirrored character."))) +Property value is a character that has the corresponding mirroring image or nil. +The value nil means that the actual property value of a character +is the character itself."))) ;; Functions to access the above data. (defsubst unidata-prop-index (prop) (nth 1 (assq prop unidata-prop-alist))) @@ -393,9 +417,18 @@ or nil for non-mirrored character."))) (while tail (setcar tail (cons (car tail) val-code)) (setq tail (cdr tail) val-code (1+ val-code))) - (setq default-value (unidata-encode-val val-list default-value)) - (set-char-table-range table t default-value) - (set-char-table-range table nil default-value) + (if (consp default-value) + (setq default-value (copy-sequence default-value)) + (setq default-value (list default-value))) + (setcar default-value + (unidata-encode-val val-list (car default-value))) + (set-char-table-range table t (car default-value)) + (set-char-table-range table nil (car default-value)) + (dolist (elm (cdr default-value)) + (setcar (nthcdr 2 elm) + (unidata-encode-val val-list (nth 2 elm))) + (set-char-table-range table (cons (car elm) (nth 1 elm)) (nth 2 elm))) + (setq tail unidata-list) (while tail (setq elt (car tail) tail (cdr tail)) @@ -419,17 +452,27 @@ or nil for non-mirrored character."))) (setq prev-range-data (cons (cons from to) val-code))))) (let* ((start (lsh (lsh range -7) 7)) (limit (+ start 127)) - str count new-val) - (fillarray vec 0) - ;; See the comment above. - (when (and prev-range-data - (>= (cdr (car prev-range-data)) start)) - (let ((from (car (car prev-range-data))) - (to (cdr (car prev-range-data))) - (vcode (cdr prev-range-data))) + str count new-val from to vcode) + (fillarray vec (car default-value)) + (dolist (elm (cdr default-value)) + (setq from (car elm) to (nth 1 elm)) + (when (and (<= from limit) + (or (>= from start) (>= to start))) + (setq from (max from start) + to (min to limit) + vcode (nth 2 elm)) (while (<= from to) (aset vec (- from start) vcode) (setq from (1+ from))))) + ;; See the comment above. + (when (and prev-range-data + (>= (cdr (car prev-range-data)) start)) + (setq from (car (car prev-range-data)) + to (cdr (car prev-range-data)) + vcode (cdr prev-range-data)) + (while (<= from to) + (aset vec (- from start) vcode) + (setq from (1+ from)))) (setq prev-range-data nil) (if val-code (aset vec (- range start) val-code)) @@ -669,7 +712,7 @@ or nil for non-mirrored character."))) (aset table c name) (if (= c char) (setq val name)))) - val))) + (or val "")))) ((and (integerp val) (> val 0)) (let* ((symbol-table (aref (char-table-extra-slot table 4) 1)) @@ -695,7 +738,9 @@ or nil for non-mirrored character."))) ((eq sym 'CJK\ COMPATIBILITY\ IDEOGRAPH) (format "%s-%04X" sym char)) ((eq sym 'VARIATION\ SELECTOR) - (format "%s-%d" sym (+ (- char #xe0100) 17)))))))) + (format "%s-%d" sym (+ (- char #xe0100) 17)))))) + + (t ""))) ;; Store VAL as the name of CHAR in TABLE. @@ -707,6 +752,9 @@ or nil for non-mirrored character."))) (defun unidata-get-decomposition (char val table) (cond + ((not val) + (list char)) + ((consp val) val) @@ -747,7 +795,8 @@ or nil for non-mirrored character."))) (aset vec idx (nconc word-list tail-list))) (dotimes (i 128) (aset table (+ first-char i) (aref vec i))) - (aref vec (- char first-char))))) + (setq val (aref vec (- char first-char))) + (or val (list char))))) ;; Hangul syllable ((and (eq val 0) (>= char #xAC00) (<= char #xD7A3)) diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 4cb4d0a6f5..4bf615328b 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,14 @@ +2011-08-24 Eli Zaretskii <[email protected]> + + * display.texi (Bidirectional Display): Document return value in + buffers that are not bidi-reordered for display, and in unibyte + buffers. + +2011-08-23 Eli Zaretskii <[email protected]> + + * nonascii.texi (Character Properties): Document the values for + unassigned codepoints. + 2011-08-18 Eli Zaretskii <[email protected]> * nonascii.texi (Character Properties): Document use of diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 8f7f400341..0593eba8f0 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -6104,7 +6104,9 @@ omitted or @code{nil}, it defaults to the current buffer. If the buffer-local value of the variable @code{bidi-paragraph-direction} is non-@code{nil}, the returned value will be identical to that value; otherwise, the returned value reflects the paragraph direction -determined dynamically by Emacs. +determined dynamically by Emacs. For buffers whose value of +@code{bidi-display-reordering} is @code{nil} as well as unibyte +buffers, this function always returns @code{left-to-right}. @end defun @cindex layout on display, and bidirectional text diff --git a/doc/lispref/nonascii.texi b/doc/lispref/nonascii.texi index 7b6d665b2a..298c7c3d1a 100644 --- a/doc/lispref/nonascii.texi +++ b/doc/lispref/nonascii.texi @@ -369,6 +369,12 @@ replacing each @samp{_} character with a dash @samp{-}. For example, @code{canonical-combining-class}. However, sometimes we shorten the names to make their use easier. +@cindex unassigned character codepoints + Some codepoints are left @dfn{unassigned} by the +@acronym{UCD}---they don't correspond to any character. The Unicode +Standard defines default values of properties for such codepoints; +they are mentioned below for each property. + Here is the full list of value types for all the character properties that Emacs knows about: @@ -376,24 +382,31 @@ properties that Emacs knows about: @item name Corresponds to the @code{Name} Unicode property. The value is a string consisting of upper-case Latin letters A to Z, digits, spaces, -and hyphen @samp{-} characters. +and hyphen @samp{-} characters. For unassigned codepoints, the value +is an empty string. @cindex unicode general category @item general-category Corresponds to the @code{General_Category} Unicode property. The value is a symbol whose name is a 2-letter abbreviation of the -character's classification. +character's classification. For unassigned codepoints, the value +is @code{Cn}. @item canonical-combining-class Corresponds to the @code{Canonical_Combining_Class} Unicode property. -The value is an integer number. +The value is an integer number. For unassigned codepoints, the value +is zero. @cindex bidirectional class of characters @item bidi-class Corresponds to the Unicode @code{Bidi_Class} property. The value is a symbol whose name is the Unicode @dfn{directional type} of the character. Emacs uses this property when it reorders bidirectional -text for display (@pxref{Bidirectional Display}). +text for display (@pxref{Bidirectional Display}). For unassigned +codepoints, the value depends on the code blocks to which the +codepoint belongs: most unassigned codepoints get the value of +@code{L} (strong L), but some get values of @code{AL} (Arabic letter) +or @code{R} (strong R). @item decomposition Corresponds to the Unicode @code{Decomposition_Type} and @@ -405,19 +418,22 @@ Note that the Unicode spec writes these tag names inside brackets; e.g., Unicode specifies @samp{<small>} where Emacs uses @samp{small}. }; the other elements are characters that give the compatibility -decomposition sequence of this character. +decomposition sequence of this character. For unassigned codepoints, +the value is the character itself. @item decimal-digit-value Corresponds to the Unicode @code{Numeric_Value} property for characters whose @code{Numeric_Type} is @samp{Digit}. The value is an -integer number. +integer number. For unassigned codepoints, the value is @code{nil}, +which means @acronym{NaN}, or ``not-a-number''. @item digit-value Corresponds to the Unicode @code{Numeric_Value} property for characters whose @code{Numeric_Type} is @samp{Decimal}. The value is an integer number. Examples of such characters include compatibility subscript and superscript digits, for which the value is the -corresponding number. +corresponding number. For unassigned codepoints, the value is +@code{nil}, which means @acronym{NaN}. @item numeric-value Corresponds to the Unicode @code{Numeric_Value} property for @@ -426,12 +442,15 @@ this property is an integer or a floating-point number. Examples of characters that have this property include fractions, subscripts, superscripts, Roman numerals, currency numerators, and encircled numbers. For example, the value of this property for the character -@code{U+2155} (@sc{vulgar fraction one fifth}) is @code{0.2}. +@code{U+2155} (@sc{vulgar fraction one fifth}) is @code{0.2}. For +unassigned codepoints, the value is @code{nil}, which means +@acronym{NaN}. @cindex mirroring of characters @item mirrored Corresponds to the Unicode @code{Bidi_Mirrored} property. The value -of this property is a symbol, either @code{Y} or @code{N}. +of this property is a symbol, either @code{Y} or @code{N}. For +unassigned codepoints, the value is @code{N}. @item mirroring Corresponds to the Unicode @code{Bidi_Mirroring_Glyph} property. The @@ -443,29 +462,33 @@ property; however, some characters whose @code{mirrored} property is @code{Y} also have @code{nil} for @code{mirroring}, because no appropriate characters exist with mirrored glyphs. Emacs uses this property to display mirror images of characters when appropriate -(@pxref{Bidirectional Display}). +(@pxref{Bidirectional Display}). For unassigned codepoints, the value +is @code{nil}. @item old-name Corresponds to the Unicode @code{Unicode_1_Name} property. The value -is a string. +is a string. For unassigned codepoints, the value is an empty string. @item iso-10646-comment Corresponds to the Unicode @code{ISO_Comment} property. The value is -a string. +a string. For unassigned codepoints, the value is an empty string. @item uppercase Corresponds to the Unicode @code{Simple_Uppercase_Mapping} property. -The value of this property is a single character. +The value of this property is a single character. For unassigned +codepoints, the value is @code{nil}, which means the character itself. @item lowercase Corresponds to the Unicode @code{Simple_Lowercase_Mapping} property. -The value of this property is a single character. +The value of this property is a single character. For unassigned +codepoints, the value is @code{nil}, which means the character itself. @item titlecase Corresponds to the Unicode @code{Simple_Titlecase_Mapping} property. @dfn{Title case} is a special form of a character used when the first character of a word needs to be capitalized. The value of this -property is a single character. +property is a single character. For unassigned codepoints, the value +is @code{nil}, which means the character itself. @end table @defun get-char-code-property char propname diff --git a/etc/ChangeLog b/etc/ChangeLog index c2f7e3cb0d..092aa6fb38 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,12 @@ +2011-08-24 Steve Chapel <[email protected]> (tiny change) + + * refcards/refcard.tex: Add a few more commands. (Bug#9343) + +2011-08-22 Juri Linkov <[email protected]> + + * compilation.txt: Add more samples of output and non-output + switches (bug#9319). + 2011-08-19 Chong Yidong <[email protected]> * themes/dichromacy-theme.el: @@ -407,7 +407,7 @@ If non-nil, C-d, [delete], and DEL delete the region if it is active and no prefix argument is given. If set to `kill', these commands kill instead. -*** New command `delete-forward-char', bound to C-d and [delete]. +*** New command `delete-forward-char', bound to [delete]. This is meant for interactive use, and obeys `delete-active-region'. The command `delete-char' does not obey `delete-active-region'. diff --git a/etc/compilation.txt b/etc/compilation.txt index 888c1f94c3..eeb09b1712 100644 --- a/etc/compilation.txt +++ b/etc/compilation.txt @@ -546,9 +546,20 @@ checking whether to build shared libraries... yes checking whether -lc should be explicitly linked in... (cached) no checking For GLIB - version >= 2.0.0... yes (version 2.1.0) checking FONTCONFIG_CFLAGS... -g++ -o foo.o foo.cc -tool1 -output=foo foo.x -tool2 --outfile foo foo.y +tool -o foo.o foo.c +tool -o=foo.o foo.c +tool -output foo.o foo.c +tool -output=foo.o foo.c +tool -outfile foo.o foo.c +tool -outfile=foo.o foo.c +tool --output foo.o foo.c +tool --output=foo.o foo.c +tool --outfile foo.o foo.c +tool --outfile=foo.o foo.c +tool -omega foo.c foo2.c +tool -output-html-file foo.c foo2.c +tool --omega foo.c foo2.c +tool --output-html-file foo.c foo2.c Compilation started at Wed Jul 20 12:20:10 Compilation interrupt at Wed Jul 20 12:20:10 diff --git a/etc/refcards/refcard.tex b/etc/refcards/refcard.tex index 52b9348db2..7d4f9dbfa8 100644 --- a/etc/refcards/refcard.tex +++ b/etc/refcards/refcard.tex @@ -332,6 +332,7 @@ If Emacs is still searching, \kbd{C-g} cancels only the part not matched. \shortcopyrightnotice +\newcolumn \section{Motion} \paralign to \hsize{#\tabskip=10pt plus 1 fil&#\tabskip=0pt&#\cr @@ -352,7 +353,10 @@ If Emacs is still searching, \kbd{C-g} cancels only the part not matched. \key{scroll to previous screen}{M-v} \key{scroll left}{C-x <} \key{scroll right}{C-x >} -\key{scroll current line to center of screen}{C-u C-l} +\key{scroll current line to center, top, bottom}{C-l} + +\key{goto line}{M-g g} +\key{back to indentation}{M-m} \section{Killing and Deleting} @@ -393,14 +397,15 @@ If Emacs is still searching, \kbd{C-g} cancels only the part not matched. Valid responses in query-replace mode are -\key{{\bf replace} this one, go on to next}{SPC} +\key{{\bf replace} this one, go on to next}{SPC {\rm or} y} \key{replace this one, don't move}{,} -\key{{\bf skip} to next without replacing}{DEL} +\key{{\bf skip} to next without replacing}{DEL {\rm or} n} \key{replace all remaining matches}{!} \key{{\bf back up} to the previous match}{^} \key{{\bf exit} query-replace}{RET} \key{enter recursive edit (\kbd{C-M-c} to exit)}{C-r} +\newcolumn \section{Multiple Windows} When two commands are shown, the second is a similar command for a @@ -438,6 +443,7 @@ frame instead of a window. \key{indent {\bf region} (mode-dependent)}{C-M-\\} \key{indent {\bf sexp} (mode-dependent)}{C-M-q} \key{indent region rigidly {\it arg\/} columns}{C-x TAB} +\key{indent for comment}{M-;} \key{insert newline after point}{C-o} \key{move rest of line vertically down}{C-M-o} @@ -536,6 +542,13 @@ minibuffer. Type \kbd{F10} to activate menu bar items on text terminals. \key{expand previous word dynamically}{M-/} +\section{Miscellaneous} + +\key{numeric argument}{C-u {\it num}} +\key{negative argument}{M--} +\key{quoted insert}{C-q {\it char}} + +\newcolumn \section{Regular Expressions} \key{any single character except a newline}{. {\rm(dot)}} @@ -604,6 +617,7 @@ Other: \endindentedkeys +\newcolumn \section{Registers} \key{save region in register}{C-x r s} diff --git a/leim/ChangeLog b/leim/ChangeLog index 5309671651..2dbccf9be3 100644 --- a/leim/ChangeLog +++ b/leim/ChangeLog @@ -1,3 +1,8 @@ +2011-08-20 Glenn Morris <[email protected]> + + * Makefile.in (OTHERS): + * makefile.w32-in (MISC): Add ipa-praat.elc. + 2011-07-23 Yair F <[email protected]> * quail/hebrew.el ("hebrew"): Additional key mappings. diff --git a/leim/Makefile.in b/leim/Makefile.in index 18eb8b62a9..87020616a5 100644 --- a/leim/Makefile.in +++ b/leim/Makefile.in @@ -124,6 +124,7 @@ OTHERS= \ ${srcdir}/quail/arabic.elc \ ${srcdir}/quail/ethiopic.elc \ ${srcdir}/quail/ipa.elc \ + ${srcdir}/quail/ipa-praat.elc \ ${srcdir}/quail/hebrew.elc \ ${srcdir}/quail/georgian.elc \ $(srcdir)/quail/persian.elc \ diff --git a/leim/makefile.w32-in b/leim/makefile.w32-in index 1ab14c72b3..231384308f 100644 --- a/leim/makefile.w32-in +++ b/leim/makefile.w32-in @@ -118,6 +118,7 @@ MISC= \ $(srcdir)/quail/arabic.elc \ $(srcdir)/quail/ethiopic.elc \ $(srcdir)/quail/ipa.elc \ + $(srcdir)/quail/ipa-praat.elc \ $(srcdir)/quail/hebrew.elc \ $(srcdir)/quail/georgian.elc \ $(srcdir)/quail/persian.elc \ diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 38c536af62..762779cc01 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,218 @@ +2011-08-24 Juri Linkov <[email protected]> + + * proced.el (proced-marked): Inherit from `error' instead of + `font-lock-warning-face'. + + * ibuffer.el (ibuffer-marked-face): Change default face from + `font-lock-warning-face' to `warning'. + (ibuffer-deletion-face): Change default face from + `font-lock-type-face' to `error'. + + * battery.el (battery-update): Use the face `error' instead of + `font-lock-warning-face' (bug#6117). + +2011-08-24 Juri Linkov <[email protected]> + + * faces.el (success): Change face color from "Green3" to + "ForestGreen" on light background (bug#9353). + +2011-08-24 Chong Yidong <[email protected]> + + * window.el (quit-window): Renamed from quit-restore-window. Use + same arglist as old quit-window. + (frame-auto-delete): Doc fix. + + * view.el (view-mode-exit): Use quit-window. + +2011-08-24 Juri Linkov <[email protected]> + + * isearch.el (isearch-ring-adjust1): Start visiting previous + search strings from the index 0 (-1 + 1) instead of 1 (0 + 1). + (isearch-repeat, isearch-edit-string): Call `isearch-ring-adjust1' + for empty search string (when the last search string is reused + automatically) to adjust the isearch ring to the last element and + prepare the correct index for further M-p commands (bug#9185). + +2011-08-24 Kenichi Handa <[email protected]> + + * international/ucs-normalize.el: If decomposition property of + CHAR is the default one (i.e. a list of CHAR itself), treat it as + nil. + (nfd, nfkd): Likewise. + +2011-08-24 Stefan Monnier <[email protected]> + + * mpc.el (mpc--proc-filter): Don't signal mpc-proc-error since signals + from process filters aren't reliably transmitted to the surrounding + accept-process-output. + (mpc-proc-check): New function. + (mpc-proc-sync): Use it (bug#8293) + +2011-08-23 Stefan Monnier <[email protected]> + + * emacs-lisp/eieio.el (eieio-defmethod, eieio-defgeneric): + Add compatibility functions (bug#9313). + +2011-08-23 Eli Zaretskii <[email protected]> + + * cus-start.el (all): Add entry for bidi-paragraph-direction. + + * international/uni-bidi.el: Regenerated. + +2011-08-23 Kenichi Handa <[email protected]> + + * international/charprop.el: + * international/uni-bidi.el: + * international/uni-category.el: + * international/uni-combining.el: + * international/uni-comment.el: + * international/uni-decimal.el: + * international/uni-decomposition.el: + * international/uni-digit.el: + * international/uni-lowercase.el: + * international/uni-mirrored.el: + * international/uni-name.el: + * international/uni-numeric.el: + * international/uni-old-name.el: + * international/uni-titlecase.el: + * international/uni-uppercase.el: Regenerate. + +2011-08-23 Martin Rudalics <[email protected]> + + * help.el (help-window-setup): Fix message displayed when other + window is reused. (Bug#9341) + +2011-08-23 Stefan Monnier <[email protected]> + + * shell.el (shell-completion-vars): Set pcomplete-arg-quote-list. + * pcomplete.el (pcomplete-quote-argument): Fix thinko (bug#9161). + + * pcomplete.el (pcomplete-parse-comint-arguments): Fix inf-loop. + Mark obsolete. + * shell.el (shell-parse-pcomplete-arguments): New function. + (shell-completion-vars): Use it instead (bug#9160). + +2011-08-22 Stefan Monnier <[email protected]> + + * progmodes/sh-script.el (sh-maybe-here-document): Disable magic in + strings and comments (bug#9333). + + * emacs-lisp/debug.el (debug-arglist): New function. + (debug-convert-byte-code): Use it. Handle lexical byte-codes. + (debug-on-entry-1): Handle interpreted closures (bug#9120). + +2011-08-22 Juri Linkov <[email protected]> + + * progmodes/compile.el (compilation-mode-font-lock-keywords): + Revert regexp that highlights output switches to its old + pre-2010-10-28 value and remove one `?' from it (bug#9319). + + * progmodes/grep.el (grep-process-setup): Use `buffer-modified-p' + to check for empty output (bug#9226). + +2011-08-22 Chong Yidong <[email protected]> + + * progmodes/scheme.el (scheme-mode-syntax-table): Don't use + symbol-constituent as the default, as that stops font-lock from + working properly (Bug#8843). + +2011-08-21 Lars Magne Ingebrigtsen <[email protected]> + + * mail/smtpmail.el (smtpmail-via-smtp): Only bind + `coding-system-for-*' around the process open call to avoid + auth-source side effects. + (smtpmail-try-auth-methods): Expand the secret password. + (smtpmail-query-smtp-server): Allow `quit'-ing out in case the + probe hangs. + +2011-08-21 Chong Yidong <[email protected]> + + * term.el (term-mouse-paste): Yank primary selection (Bug#6845). + + * emacs-lisp/find-func.el (find-function-noselect): New arg + lisp-only. + + * emacs-lisp/edebug.el (edebug-instrument-function): Use it to + signal an error for built-in functions (Bug#6664). + +2011-08-21 Lars Magne Ingebrigtsen <[email protected]> + + * mail/smtpmail.el (smtpmail-smtp-user): New variable. + (smtpmail-try-auth-methods): Use it. + +2011-08-21 Chong Yidong <[email protected]> + + * font-lock.el (font-lock-fontify-region) + (font-lock-unfontify-region, font-lock-default-fontify-buffer) + (font-lock-default-unfontify-buffer) + (font-lock-default-fontify-region) + (font-lock-default-unfontify-region): Add docstrings (Bug#8624). + + * progmodes/compile.el (compilation-error-properties): + Fix confusion between file struct and message struct (Bug#9319). + (compilation-error-regexp-alist-alist): Fix 2011-05-09 change to + `ant' regexp. + + * net/browse-url.el (browse-url-firefox): Don't call + browse-url-firefox-sentinel unless using -remote (Bug#9328). + +2011-08-20 Glenn Morris <[email protected]> + + * tutorial.el (help-with-tutorial): Avoid an error on short screens. + + * tutorial.el (tutorial--default-keys): Update some default bindings. + + * files.el (hack-local-variables): Fully ignore case for "mode:". + +2011-08-20 Alan Mackenzie <[email protected]> + + Resolve invalid use of a regexp in regexp-opt. + + * cc-fonts.el (c-complex-decl-matchers): Add in special detection + for a java annotation. + + * cc-engine.el (c-forward-decl-or-cast-1): Add in special + detection for a java annotation. + + * cc-langs.el (c-prefix-spec-kwds-re): Remove the special handling + for java. + (c-modifier-kwds): Remove the regexp "@[A-za-z0-9]+". + +2011-08-20 Chong Yidong <[email protected]> + + * startup.el (normal-top-level-add-subdirs-to-load-path): Doc fix + (Bug#9274). + +2011-08-20 Alan Mackenzie <[email protected]> + + * Fontify CPP expressions correctly when starting in the middle of + such a construct. Mainly for when jit-lock etc. starts a chunk + here. + + * progmodes/cc-fonts.el (c-font-lock-context): new buffer local + variable. + (c-make-font-lock-search-form): new function, extracted from + c-make-font-lock-search-function. + (c-make-font-lock-search-function): Use the above function. + (c-make-font-lock-context-search-function): New function. + (c-cpp-matchers): Enhance the preprocessor expression case with + the above function + (c-font-lock-complex-decl-prepare): Test for being in a CPP form + which takes an expression. + + * progmodes/cc-langs.el (c-cpp-expr-intro-re): New lang-variable. + +2011-08-20 Martin Rudalics <[email protected]> + + * window.el (display-buffer-reuse-window) + (display-buffer-pop-up-window): Don't reuse or split a side + window. + +2011-08-19 Glenn Morris <[email protected]> + + * files.el (hack-local-variables-prop-line, hack-local-variables): + Downcase "Mode:". (Bug#9331) + 2011-08-18 Chong Yidong <[email protected]> * international/characters.el: Add L and R categories. @@ -28,8 +243,8 @@ binding variables (bug#9298). Also clean up some unused autoloads. - * net/network-stream.el (network-stream-open-starttls): Support - using starttls.el without using gnutls-cli. + * net/network-stream.el (network-stream-open-starttls): + Support using starttls.el without using gnutls-cli. 2011-08-17 Juri Linkov <[email protected]> diff --git a/lisp/battery.el b/lisp/battery.el index d7d3045fa5..e0bba96b65 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -199,7 +199,7 @@ seconds." 'face (and (<= (car (read-from-string (cdr (assq ?p data)))) battery-load-critical) - 'font-lock-warning-face) + 'error) 'help-echo "Battery status information"))) (force-mode-line-update)) diff --git a/lisp/bindings.el b/lisp/bindings.el index c4f9369219..57bfeb60f8 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -834,6 +834,7 @@ if `inhibit-field-text-motion' is non-nil." (setq i (1+ i)))) (define-key global-map [?\C-\M--] 'negative-argument) +;; Update tutorial--default-keys if you change these. (define-key global-map "\177" 'delete-backward-char) (define-key global-map "\C-d" 'delete-char) diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 389716b35b..232c6c3808 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -118,6 +118,13 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of :standard (not noninteractive) :initialize custom-initialize-delay :set custom-set-minor-mode) + (bidi-paragraph-direction + paragraphs + (choice + (const :tag "Left to Right" left-to-right) + (const :tag "Right to Left" right-to-left) + (const :tag "Dynamic, according to paragraph text" nil)) + "24.1") ;; callint.c (mark-even-if-inactive editing-basics boolean) ;; callproc.c diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 157749500e..8276030ccf 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -778,6 +778,7 @@ Redefining FUNCTION also cancels it." (not (debugger-special-form-p symbol)))) t nil nil (symbol-name fn))) (list (if (equal val "") fn (intern val))))) + ;; FIXME: Use advice.el. (when (debugger-special-form-p function) (error "Function %s is a special form" function)) (if (or (symbolp (symbol-function function)) @@ -835,24 +836,30 @@ To specify a nil argument interactively, exit with an empty minibuffer." (message "Cancelling debug-on-entry for all functions") (mapcar 'cancel-debug-on-entry debug-function-list))) +(defun debug-arglist (definition) + ;; FIXME: copied from ad-arglist. + "Return the argument list of DEFINITION." + (require 'help-fns) + (help-function-arglist definition 'preserve-names)) + (defun debug-convert-byte-code (function) (let* ((defn (symbol-function function)) (macro (eq (car-safe defn) 'macro))) (when macro (setq defn (cdr defn))) - (unless (consp defn) - ;; Assume a compiled code object. - (let* ((contents (append defn nil)) + (when (byte-code-function-p defn) + (let* ((args (debug-arglist defn)) (body - (list (list 'byte-code (nth 1 contents) - (nth 2 contents) (nth 3 contents))))) - (if (nthcdr 5 contents) - (setq body (cons (list 'interactive (nth 5 contents)) body))) - (if (nth 4 contents) + `((,(if (memq '&rest args) #'apply #'funcall) + ,defn + ,@(remq '&rest (remq '&optional args)))))) + (if (> (length defn) 5) + (push `(interactive ,(aref defn 5)) body)) + (if (aref defn 4) ;; Use `documentation' here, to get the actual string, ;; in case the compiled function has a reference ;; to the .elc file. (setq body (cons (documentation function) body))) - (setq defn (cons 'lambda (cons (car contents) body)))) + (setq defn `(closure (t) ,args ,@body))) (when macro (setq defn (cons 'macro defn))) (fset function defn)))) @@ -861,11 +868,12 @@ To specify a nil argument interactively, exit with an empty minibuffer." (tail defn)) (when (eq (car-safe tail) 'macro) (setq tail (cdr tail))) - (if (not (eq (car-safe tail) 'lambda)) + (if (not (memq (car-safe tail) '(closure lambda))) ;; Only signal an error when we try to set debug-on-entry. ;; When we try to clear debug-on-entry, we are now done. (when flag (error "%s is not a user-defined Lisp function" function)) + (if (eq (car tail) 'closure) (setq tail (cdr tail))) (setq tail (cdr tail)) ;; Skip the docstring. (when (and (stringp (cadr tail)) (cddr tail)) @@ -875,9 +883,9 @@ To specify a nil argument interactively, exit with an empty minibuffer." (setq tail (cdr tail))) (unless (eq flag (equal (cadr tail) '(implement-debug-on-entry))) ;; Add/remove debug statement as needed. - (if flag - (setcdr tail (cons '(implement-debug-on-entry) (cdr tail))) - (setcdr tail (cddr tail))))) + (setcdr tail (if flag + (cons '(implement-debug-on-entry) (cdr tail)) + (cddr tail))))) defn)) (defun debugger-list-functions () diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index f84de0308b..57d25c9e16 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -3408,7 +3408,7 @@ go to the end of the last sexp, or if that is the same point, then step." (message "%s is already instrumented." func) func) (t - (let ((loc (find-function-noselect func))) + (let ((loc (find-function-noselect func t))) (unless (cdr loc) (error "Could not find the definition in its file")) (with-current-buffer (car loc) diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 83c09b6fe0..f1fe9594fc 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -1312,20 +1312,20 @@ Summary: (defun eieio--defmethod (method kind argclass code) "Work part of the `defmethod' macro defining METHOD with ARGS." (let ((key - ;; find optional keys + ;; find optional keys (cond ((or (eq ':BEFORE kind) (eq ':before kind)) - method-before) + method-before) ((or (eq ':AFTER kind) (eq ':after kind)) - method-after) + method-after) ((or (eq ':PRIMARY kind) (eq ':primary kind)) - method-primary) + method-primary) ((or (eq ':STATIC kind) (eq ':static kind)) - method-static) - ;; Primary key + method-static) + ;; Primary key (t method-primary)))) ;; Make sure there is a generic (when called from defclass). (eieio--defalias @@ -1338,8 +1338,8 @@ Summary: ;; under the type `primary' which is a non-specific calling of the ;; function. (if argclass - (if (not (class-p argclass)) - (error "Unknown class type %s in method parameters" + (if (not (class-p argclass)) + (error "Unknown class type %s in method parameters" argclass)) (if (= key -1) (signal 'wrong-type-argument (list :static 'non-class-arg))) @@ -2864,6 +2864,106 @@ of `eq'." ) +;;; Obsolete backward compatibility functions. +;; Needed to run byte-code compiled with the EIEIO of Emacs-23. + +(defun eieio-defmethod (method args) + "Obsolete work part of an old version of the `defmethod' macro." + (let ((key nil) (body nil) (firstarg nil) (argfix nil) (argclass nil) loopa) + ;; find optional keys + (setq key + (cond ((or (eq ':BEFORE (car args)) + (eq ':before (car args))) + (setq args (cdr args)) + method-before) + ((or (eq ':AFTER (car args)) + (eq ':after (car args))) + (setq args (cdr args)) + method-after) + ((or (eq ':PRIMARY (car args)) + (eq ':primary (car args))) + (setq args (cdr args)) + method-primary) + ((or (eq ':STATIC (car args)) + (eq ':static (car args))) + (setq args (cdr args)) + method-static) + ;; Primary key + (t method-primary))) + ;; get body, and fix contents of args to be the arguments of the fn. + (setq body (cdr args) + args (car args)) + (setq loopa args) + ;; Create a fixed version of the arguments + (while loopa + (setq argfix (cons (if (listp (car loopa)) (car (car loopa)) (car loopa)) + argfix)) + (setq loopa (cdr loopa))) + ;; make sure there is a generic + (eieio-defgeneric + method + (if (stringp (car body)) + (car body) (format "Generically created method `%s'." method))) + ;; create symbol for property to bind to. If the first arg is of + ;; the form (varname vartype) and `vartype' is a class, then + ;; that class will be the type symbol. If not, then it will fall + ;; under the type `primary' which is a non-specific calling of the + ;; function. + (setq firstarg (car args)) + (if (listp firstarg) + (progn + (setq argclass (nth 1 firstarg)) + (if (not (class-p argclass)) + (error "Unknown class type %s in method parameters" + (nth 1 firstarg)))) + (if (= key -1) + (signal 'wrong-type-argument (list :static 'non-class-arg))) + ;; generics are higher + (setq key (eieio-specialized-key-to-generic-key key))) + ;; Put this lambda into the symbol so we can find it + (if (byte-code-function-p (car-safe body)) + (eieiomt-add method (car-safe body) key argclass) + (eieiomt-add method (append (list 'lambda (reverse argfix)) body) + key argclass)) + ) + + (when eieio-optimize-primary-methods-flag + ;; Optimizing step: + ;; + ;; If this method, after this setup, only has primary methods, then + ;; we can setup the generic that way. + (if (generic-primary-only-p method) + ;; If there is only one primary method, then we can go one more + ;; optimization step. + (if (generic-primary-only-one-p method) + (eieio-defgeneric-reset-generic-form-primary-only-one method) + (eieio-defgeneric-reset-generic-form-primary-only method)) + (eieio-defgeneric-reset-generic-form method))) + + method) +(make-obsolete 'eieio-defmethod 'eieio--defmethod "24.1") + +(defun eieio-defgeneric (method doc-string) + "Obsolete work part of an old version of the `defgeneric' macro." + (if (and (fboundp method) (not (generic-p method)) + (or (byte-code-function-p (symbol-function method)) + (not (eq 'autoload (car (symbol-function method))))) + ) + (error "You cannot create a generic/method over an existing symbol: %s" + method)) + ;; Don't do this over and over. + (unless (fboundp 'method) + ;; This defun tells emacs where the first definition of this + ;; method is defined. + `(defun ,method nil) + ;; Make sure the method tables are installed. + (eieiomt-install method) + ;; Apply the actual body of this function. + (fset method (eieio-defgeneric-form method doc-string)) + ;; Return the method + 'method)) +(make-obsolete 'eieio-defgeneric nil "24.1") + ;;; Interfacing with edebug ;; (defun eieio-edebug-prin1-to-string (object &optional noescape) diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 0194af2e3a..2c7208db8a 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -312,7 +312,7 @@ The search is done in the source for library LIBRARY." (cons (current-buffer) nil)))))))) ;;;###autoload -(defun find-function-noselect (function) +(defun find-function-noselect (function &optional lisp-only) "Return a pair (BUFFER . POINT) pointing to the definition of FUNCTION. Finds the source file containing the definition of FUNCTION @@ -320,6 +320,10 @@ in a buffer and the point of the definition. The buffer is not selected. If the function definition can't be found in the buffer, returns (BUFFER). +If FUNCTION is a built-in function, this function normally +attempts to find it in the Emacs C sources; however, if LISP-ONLY +is non-nil, signal an error instead. + If the file where FUNCTION is defined is not known, then it is searched for in `find-function-source-path' if non-nil, otherwise in `load-path'." @@ -345,6 +349,8 @@ in `load-path'." (cond ((eq (car-safe def) 'autoload) (nth 1 def)) ((subrp def) + (if lisp-only + (error "%s is a built-in function" function)) (help-C-file-name def 'subr)) ((symbol-file function 'defun))))) (find-function-search-for-symbol function nil library)))) diff --git a/lisp/faces.el b/lisp/faces.el index 404bd7b660..3c4a3330c8 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2435,7 +2435,7 @@ It is used for characters of no fonts too." (defface success '((((class color) (min-colors 16) (background light)) - (:foreground "Green3" :weight bold)) + (:foreground "ForestGreen" :weight bold)) (((class color) (min-colors 88) (background dark)) (:foreground "Green1" :weight bold)) (((class color) (min-colors 16) (background dark)) diff --git a/lisp/files.el b/lisp/files.el index 6b8a352f20..07188e152b 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3003,9 +3003,10 @@ mode, if there is one, otherwise nil." "-mode")))) (or (equal keyname "coding") (condition-case nil - (push (cons (if (eq key 'eval) - 'eval - (indirect-variable key)) + (push (cons (cond ((eq key 'eval) 'eval) + ;; Downcase "Mode:". + ((equal keyname "mode") 'mode) + (t (indirect-variable key))) val) result) (error nil)))) (skip-chars-forward " \t;"))) @@ -3153,6 +3154,8 @@ major-mode." (var (let ((read-circle nil)) (read str))) val val2) + (and (equal (downcase (symbol-name var)) "mode") + (setq var 'mode)) ;; Read the variable value. (skip-chars-forward "^:") (forward-char 1) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 9cf889e1ae..c37a9ae916 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -1018,14 +1018,20 @@ The region it returns may start or end in the middle of a line.") (funcall font-lock-unfontify-buffer-function)) (defun font-lock-fontify-region (beg end &optional loudly) + "Fontify the text between BEG and END. +If LOUDLY is non-nil, print status messages while fontifying. +This works by calling `font-lock-fontify-region-function'." (font-lock-set-defaults) (funcall font-lock-fontify-region-function beg end loudly)) (defun font-lock-unfontify-region (beg end) + "Unfontify the text between BEG and END. +This works by calling `font-lock-unfontify-region-function'." (save-buffer-state (funcall font-lock-unfontify-region-function beg end))) (defun font-lock-default-fontify-buffer () + "Fontify the whole buffer using `font-lock-fontify-region-function'." (let ((verbose (if (numberp font-lock-verbose) (> (buffer-size) font-lock-verbose) font-lock-verbose))) @@ -1045,6 +1051,7 @@ The region it returns may start or end in the middle of a line.") (quit (font-lock-unfontify-buffer))))))) (defun font-lock-default-unfontify-buffer () + "Unfontify the whole buffer using `font-lock-unfontify-region-function'." ;; Make sure we unfontify etc. in the whole buffer. (save-restriction (widen) @@ -1114,6 +1121,9 @@ Put first the functions more likely to cause a change and cheaper to compute.") changed)) (defun font-lock-default-fontify-region (beg end loudly) + "Fontify the text between BEG and END. +If LOUDLY is non-nil, print status messages while fontifying. +This function is the default `font-lock-fontify-region-function'." (save-buffer-state ;; Use the fontification syntax table, if any. (with-syntax-table (or font-lock-syntax-table (syntax-table)) @@ -1162,6 +1172,8 @@ This is used by `font-lock-default-unfontify-region' to decide what properties to clear before refontifying a region.") (defun font-lock-default-unfontify-region (beg end) + "Unfontify the text between BEG and END. +This function is the default `font-lock-unfontify-region-function'." (remove-list-of-text-properties beg end (append font-lock-extra-managed-props diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 64ac50fe8f..ad3e26f0f5 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,41 @@ +2011-08-21 Lars Magne Ingebrigtsen <[email protected]> + + * nnmail.el (nnmail-get-new-mail-1): If one mail source bugs out, + continue on and do the clean-up phase (bug#9188). + + * gnus-sum.el (gnus-summary-expire-articles): When expiring articles, + just ignore groups that can't be opened instead of erroring out + (bug#9225). + + * gnus-art.el (gnus-article-update-date-headers): Flip the default to + nil since some many people are fuddy-duddies. + + * gnus-html.el (gnus-html-image-fetched): Don't cache zero-length + images. + + * nntp.el (nntp-authinfo-file): Mark as obsolete -- use auth-source + instead. + + * pop3.el (pop3-wait-for-messages): Don't use Gnus functions here. + + * gnus-util.el (gnus-process-live-p): Copy over compat function. + + * pop3.el (pop3-wait-for-messages): If the pop3 process dies, stop + processing. + + * nntp.el (nntp-kill-buffer): Kill the process before killing the + buffer to avoid warnings. + +2011-08-20 Simon Josefsson <[email protected]> + + * gnus-agent.el (gnus-agent-expire-done-message): Use %.f as format + specified to reduce precision. + +2011-08-19 Lars Magne Ingebrigtsen <[email protected]> + + * nnimap.el (nnimap-transform-headers): Protect against (NIL ...) + bodystructures (bug#9314). + 2011-08-19 Katsumi Yamaoka <[email protected]> * gnus-art.el (gnus-insert-mime-button, gnus-mime-display-alternative): @@ -12,8 +50,29 @@ `gnus-registry-get-id-key' since `gnus-registry-fetch-groups' isn't available anymore. +2011-08-12 Simon Josefsson <[email protected]> + + * starttls.el (starttls-any-program-available): Define as obsolete + function. + +2011-08-18 Lars Magne Ingebrigtsen <[email protected]> + + * gnus-util.el (gnus-y-or-n-p): Reinstate the message-clearing y-or-n-p + versions which Gnus use when appropriate. + + * gnus-group.el (gnus-group-clear-data): Add a y-or-n query, since it's + a pretty destructive command. + + * nnmail.el (nnmail-extra-headers): Clarify slightly (bug#9302). + 2011-08-17 Lars Magne Ingebrigtsen <[email protected]> + * message.el (message-fix-before-sending): Make a different warning + about NUL characters (bug#9270). + + * gnus-sum.el (gnus-auto-select-subject): Allow specifying a function + from custom (bug#9260). + * gnus-spec.el (gnus-lrm-string): Use 8206 instead of ?\x200e to make things work in Emacs 22 and XEmacs, too. diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 424c55c40f..26222119b9 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -3560,7 +3560,7 @@ articles in every agentized group? ")) units (cdr units))) (format "Expiry recovered %d NOV entries, deleted %d files,\ - and freed %f %s." + and freed %.f %s." (nth 0 stats) (nth 1 stats) size (car units))) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index c6e0180dad..eaf0ed52f5 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -1039,7 +1039,7 @@ Some of these headers are updated automatically. See (item :tag "ISO8601 format" :value 'iso8601) (item :tag "User-defined" :value 'user-defined))) -(defcustom gnus-article-update-date-headers 1 +(defcustom gnus-article-update-date-headers nil "A number that says how often to update the date header (in seconds). If nil, don't update it at all." :version "24.1" diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 2a31ccd34f..5ae29053b6 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -3471,13 +3471,14 @@ sort in reverse order." "Clear all marks and read ranges from the current group. Obeys the process/prefix convention." (interactive "P") - (gnus-group-iterate arg - (lambda (group) - (let (info) - (gnus-info-clear-data (setq info (gnus-get-info group))) - (gnus-get-unread-articles-in-group info (gnus-active group) t) - (when (gnus-group-goto-group group) - (gnus-group-update-group-line)))))) + (when (gnus-y-or-n-p "Really clear data? ") + (gnus-group-iterate arg + (lambda (group) + (let (info) + (gnus-info-clear-data (setq info (gnus-get-info group))) + (gnus-get-unread-articles-in-group info (gnus-active group) t) + (when (gnus-group-goto-group group) + (gnus-group-update-group-line))))))) (defun gnus-group-clear-data-on-native-groups () "Clear all marks and read ranges from all native groups." diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index d3da6aab1b..f443c4021e 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el @@ -399,15 +399,16 @@ Use ALT-TEXT for the image string." (defun gnus-html-image-fetched (status buffer image) "Callback function called when image has been fetched." (unless (plist-get status :error) - (when gnus-html-image-automatic-caching - (url-store-in-cache (current-buffer))) (when (and (or (search-forward "\n\n" nil t) (search-forward "\r\n\r\n" nil t)) - (buffer-live-p buffer)) - (let ((data (buffer-substring (point) (point-max)))) - (with-current-buffer buffer - (let ((inhibit-read-only t)) - (gnus-html-put-image data (car image) (cadr image))))))) + (not (eobp))) + (when gnus-html-image-automatic-caching + (url-store-in-cache (current-buffer))) + (when (buffer-live-p buffer) + (let ((data (buffer-substring (point) (point-max)))) + (with-current-buffer buffer + (let ((inhibit-read-only t)) + (gnus-html-put-image data (car image) (cadr image)))))))) (kill-buffer (current-buffer))) (defun gnus-html-get-image-data (url) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index cd4699e610..c01f91973a 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -375,7 +375,8 @@ place point on some subject line." (const unread) (const first) (const unseen) - (const unseen-or-unread))) + (const unseen-or-unread) + (function :tag "Function to call"))) (defcustom gnus-auto-select-next t "*If non-nil, offer to go to the next group from the end of the previous. @@ -10286,34 +10287,33 @@ This will be the case if the article has both been mailed and posted." ;; There are expirable articles in this group, so we run them ;; through the expiry process. (gnus-message 6 "Expiring articles...") - (unless (gnus-check-group gnus-newsgroup-name) - (error "Can't open server for %s" gnus-newsgroup-name)) - ;; The list of articles that weren't expired is returned. - (save-excursion - (if expiry-wait - (let ((nnmail-expiry-wait-function nil) - (nnmail-expiry-wait expiry-wait)) - (setq es (gnus-request-expire-articles - expirable gnus-newsgroup-name))) - (setq es (gnus-request-expire-articles - expirable gnus-newsgroup-name))) - (unless total - (setq gnus-newsgroup-expirable es)) - ;; We go through the old list of expirable, and mark all - ;; really expired articles as nonexistent. - (unless (eq es expirable) ;If nothing was expired, we don't mark. - (let ((gnus-use-cache nil)) - (dolist (article expirable) - (when (and (not (memq article es)) - (gnus-data-find article)) - (gnus-summary-mark-article article gnus-canceled-mark) - (run-hook-with-args 'gnus-summary-article-expire-hook - 'delete - (gnus-data-header - (assoc article (gnus-data-list nil))) - gnus-newsgroup-name - nil - nil)))))) + (when (gnus-check-group gnus-newsgroup-name) + ;; The list of articles that weren't expired is returned. + (save-excursion + (if expiry-wait + (let ((nnmail-expiry-wait-function nil) + (nnmail-expiry-wait expiry-wait)) + (setq es (gnus-request-expire-articles + expirable gnus-newsgroup-name))) + (setq es (gnus-request-expire-articles + expirable gnus-newsgroup-name))) + (unless total + (setq gnus-newsgroup-expirable es)) + ;; We go through the old list of expirable, and mark all + ;; really expired articles as nonexistent. + (unless (eq es expirable) ;If nothing was expired, we don't mark. + (let ((gnus-use-cache nil)) + (dolist (article expirable) + (when (and (not (memq article es)) + (gnus-data-find article)) + (gnus-summary-mark-article article gnus-canceled-mark) + (run-hook-with-args 'gnus-summary-article-expire-hook + 'delete + (gnus-data-header + (assoc article (gnus-data-list nil))) + gnus-newsgroup-name + nil + nil))))))) (gnus-message 6 "Expiring articles...done"))))) (defun gnus-summary-expire-articles-now () diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 7155c7f960..3495361196 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -388,57 +388,14 @@ TIME defaults to the current time." (define-key keymap key (pop plist)) (pop plist))))) -;; Two silly functions to ensure that all `y-or-n-p' questions clear -;; the echo area. -;; -;; Do we really need these functions? Workarounds for bugs in the corresponding -;; Emacs functions? Maybe these bugs are no longer present in any supported -;; (X)Emacs version? Alias them to the original functions and see if anyone -;; reports a problem. If not, replace with original functions. --rsteib, -;; 2007-12-14 -;; -;; All supported Emacsen clear the echo area after `yes-or-no-p', so we can -;; remove `yes-or-no-p'. RMS says that not clearing after `y-or-n-p' is -;; intentional (see below), so we could remove `gnus-y-or-n-p' too. -;; Objections? --rsteib, 2008-02-16 -;; -;; ,----[ http://thread.gmane.org/gmane.emacs.gnus.general/65099/focus=66070 ] -;; | From: Richard Stallman -;; | Subject: Re: Do we need gnus-yes-or-no-p and gnus-y-or-n-p? -;; | To: Katsumi Yamaoka [...] -;; | Cc: emacs-devel@[...], xemacs-beta@[...], ding@[...] -;; | Date: Mon, 07 Jan 2008 12:16:05 -0500 -;; | Message-ID: <[email protected]> -;; | -;; | The behavior of `y-or-n-p' that it doesn't clear the question -;; | and the answer is not serious of course, but I feel it is not -;; | cool. -;; | -;; | It is intentional. -;; | -;; | Currently, it is commented out in the trunk by Reiner Steib. He -;; | also wrote the benefit of leaving the question and the answer in -;; | the echo area as follows: -;; | -;; | (http://article.gmane.org/gmane.emacs.gnus.general/66061) -;; | > In contrast to yes-or-no-p it is much easier to type y, n, -;; | > SPC, DEL, etc accidentally, so it might be useful for the user -;; | > to see what he has typed. -;; | -;; | Yes, that is the reason. -;; `---- - -;; (defun gnus-y-or-n-p (prompt) -;; (prog1 -;; (y-or-n-p prompt) -;; (message ""))) -;; (defun gnus-yes-or-no-p (prompt) -;; (prog1 -;; (yes-or-no-p prompt) -;; (message ""))) - -(defalias 'gnus-y-or-n-p 'y-or-n-p) -(defalias 'gnus-yes-or-no-p 'yes-or-no-p) +(defun gnus-y-or-n-p (prompt) + (prog1 + (y-or-n-p prompt) + (message ""))) +(defun gnus-yes-or-no-p (prompt) + (prog1 + (yes-or-no-p prompt) + (message ""))) ;; By Frank Schmitt <[email protected]>. Allows to have ;; age-depending date representations. (e.g. just the time if it's @@ -1292,6 +1249,13 @@ This function saves the current buffer." (with-current-buffer gnus-group-buffer (eq major-mode 'gnus-group-mode)))) +(defun gnus-process-live-p (process) + "Returns non-nil if PROCESS is alive. +A process is considered alive if its status is `run', `open', +`listen', `connect' or `stop'." + (memq (process-status process) + '(run open listen connect stop))) + (defun gnus-remove-if (predicate sequence &optional hash-table-p) "Return a copy of SEQUENCE with all items satisfying PREDICATE removed. SEQUENCE should be a list, a vector, or a string. Returns always a list. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index a157afe2ce..52cef1925a 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -4254,8 +4254,10 @@ conformance." "Invisible text found and made visible; continue sending? ") (error "Invisible text found and made visible"))))) (message-check 'illegible-text - (let (char found choice) + (let (char found choice nul-chars) (message-goto-body) + (setq nul-chars (save-excursion + (search-forward "\000" nil t))) (while (progn (skip-chars-forward mm-7bit-chars) (when (get-text-property (point) 'no-illegible-text) @@ -4281,7 +4283,9 @@ conformance." (when found (setq choice (gnus-multiple-choice - "Non-printable characters found. Continue sending?" + (if nul-chars + "NUL characters found, which may cause problems. Continue sending?" + "Non-printable characters found. Continue sending?") `((?d "Remove non-printable characters and send") (?r ,(format "Replace non-printable characters with \"%s\" and send" diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index c940e06fbb..2dbc465f8c 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -216,9 +216,10 @@ textual parts.") (let ((structure (ignore-errors (read (current-buffer))))) (while (and (consp structure) - (not (stringp (car structure)))) + (not (atom (car structure)))) (setq structure (car structure))) (setq lines (if (and + (stringp (car structure)) (equal (upcase (nth 0 structure)) "MESSAGE") (equal (upcase (nth 1 structure)) "RFC822")) (nth 9 structure) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index 8906a03677..d83467a1ed 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -554,7 +554,9 @@ parameter. It should return nil, `warn' or `delete'." (const delete))) (defcustom nnmail-extra-headers '(To Newsgroups) - "*Extra headers to parse." + "Extra headers to parse. +In addition to the standard headers, these extra headers will be +included in NOV headers (and the like) when backends parse headers." :version "21.1" :group 'nnmail :type '(repeat symbol)) @@ -1840,18 +1842,23 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ;; and fetch the mail from each. (while (setq source (pop fetching-sources)) (when (setq new - (mail-source-fetch - source - (gnus-byte-compile - `(lambda (file orig-file) - (nnmail-split-incoming - file ',(intern (format "%s-save-mail" method)) - ',spool-func - (or in-group - (if (equal file orig-file) - nil - (nnmail-get-split-group orig-file ',source))) - ',(intern (format "%s-active-number" method))))))) + (condition-case cond + (mail-source-fetch + source + (gnus-byte-compile + `(lambda (file orig-file) + (nnmail-split-incoming + file ',(intern (format "%s-save-mail" method)) + ',spool-func + (or in-group + (if (equal file orig-file) + nil + (nnmail-get-split-group orig-file + ',source))) + ',(intern (format "%s-active-number" method)))))) + ((error quit) + (message "Mail source %s failed: %s" source cond) + 0))) (incf total new) (incf i))) ;; If we did indeed read any incoming spools, we save all info. diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index 986fd51a61..325aa67f80 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -261,6 +261,8 @@ See `nnml-marks-is-evil' for more information.") (const :format "" "password") (string :format "Password: %v"))))))) +(make-obsolete 'nntp-authinfo-file nil "Emacs 24.1") + (defvoo nntp-connection-timeout nil @@ -430,6 +432,9 @@ be restored and the command retried." (defun nntp-kill-buffer (buffer) (when (buffer-name buffer) + (let ((process (get-buffer-process buffer))) + (when process + (delete-process process))) (kill-buffer buffer) (nnheader-init-server-buffer))) diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el index e29ddb0d44..54c2170383 100644 --- a/lisp/gnus/pop3.el +++ b/lisp/gnus/pop3.el @@ -178,6 +178,8 @@ Use streaming commands." (defun pop3-wait-for-messages (process count total-size) (while (< (pop3-number-of-responses total-size) count) + (unless (memq (process-status process) '(open run)) + (error "pop3 process died")) (when total-size (message "pop3 retrieved %dKB (%d%%)" (truncate (/ (buffer-size) 1000)) diff --git a/lisp/gnus/starttls.el b/lisp/gnus/starttls.el index c1caca90cf..b995f7478c 100644 --- a/lisp/gnus/starttls.el +++ b/lisp/gnus/starttls.el @@ -301,6 +301,10 @@ GNUTLS requires a port number." starttls-gnutls-program starttls-program))) +(defalias 'starttls-any-program-available 'starttls-available-p) +(make-obsolete 'starttls-any-program-available 'starttls-available-p + "2011-08-02") + (provide 'starttls) ;;; starttls.el ends here diff --git a/lisp/help.el b/lisp/help.el index e6496f625d..710dc34ea8 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1104,7 +1104,7 @@ This relies on `display-buffer-window' being correctly set up by ((eq help-value 'new-window) "Type \\[delete-other-windows] to delete the help window") ((eq help-value 'reuse-other-window) - "Type \\[switch-to-prev-buffer] RET to restore previous buffer")) + "Type \"q\" in other window to quit")) help-window 'other)) (t ;; Not much to say here. diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 725192399f..5a86508e14 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -356,12 +356,12 @@ directory, like `default-directory'." :type 'hook :group 'ibuffer) -(defcustom ibuffer-marked-face 'font-lock-warning-face +(defcustom ibuffer-marked-face 'warning "Face used for displaying marked buffers." :type 'face :group 'ibuffer) -(defcustom ibuffer-deletion-face 'font-lock-type-face +(defcustom ibuffer-deletion-face 'error "Face used for displaying buffers marked for deletion." :type 'face :group 'ibuffer) diff --git a/lisp/international/charprop.el b/lisp/international/charprop.el index 919666010b..2424e87ae4 100644 --- a/lisp/international/charprop.el +++ b/lisp/international/charprop.el @@ -29,15 +29,18 @@ one of these symbols representing compatibility formatting tag: ;; FILE: uni-decimal.el (define-char-code-property 'decimal-digit-value "uni-decimal.el" "Unicode numeric value (decimal digit). -Property value is an integer.") +Property value is an integer 0..9, or nil. +The value nil stands for NaN \"Numeric_Value\".") ;; FILE: uni-digit.el (define-char-code-property 'digit-value "uni-digit.el" "Unicode numeric value (digit). -Property value is an integer.") +Property value is an integer 0..9, or nil. +The value nil stands for NaN \"Numeric_Value\".") ;; FILE: uni-numeric.el (define-char-code-property 'numeric-value "uni-numeric.el" "Unicode numeric value (numeric). -Property value is an integer or a floating point.") +Property value is an integer, a floating point, or nil. +The value nil stands for NaN \"Numeric_Value\".") ;; FILE: uni-mirrored.el (define-char-code-property 'mirrored "uni-mirrored.el" "Unicode bidi mirrored flag. @@ -53,20 +56,27 @@ Property value is a string.") ;; FILE: uni-uppercase.el (define-char-code-property 'uppercase "uni-uppercase.el" "Unicode simple uppercase mapping. -Property value is a character.") +Property value is a character or nil. +The value nil means that the actual property value of a character +is the character itself.") ;; FILE: uni-lowercase.el (define-char-code-property 'lowercase "uni-lowercase.el" "Unicode simple lowercase mapping. -Property value is a character.") +Property value is a character or nil. +The value nil means that the actual property value of a character +is the character itself.") ;; FILE: uni-titlecase.el (define-char-code-property 'titlecase "uni-titlecase.el" "Unicode simple titlecase mapping. -Property value is a character.") +Property value is a character or nil. +The value nil means that the actual property value of a character +is the character itself.") ;; FILE: uni-mirrored.el (define-char-code-property 'mirroring "uni-mirrored.el" "Unicode bidi-mirroring characters. -Property value is a character that has the corresponding mirroring image, -or nil for non-mirrored character.") +Property value is a character that has the corresponding mirroring image or nil. +The value nil means that the actual property value of a character +is the character itself.") ;; Local Variables: ;; coding: utf-8 ;; no-byte-compile: t diff --git a/lisp/international/ucs-normalize.el b/lisp/international/ucs-normalize.el index f83e0f7588..df05b355b4 100644 --- a/lisp/international/ucs-normalize.el +++ b/lisp/international/ucs-normalize.el @@ -139,14 +139,17 @@ (defun nfd (char) (let ((decomposition (get-char-code-property char 'decomposition))) - (if (and decomposition (numberp (car decomposition))) + (if (and decomposition (numberp (car decomposition)) + (or (> (length decomposition) 1) + (/= (car decomposition) char))) decomposition))) (defun nfkd (char) (let ((decomposition (get-char-code-property char 'decomposition))) (if (symbolp (car decomposition)) (cdr decomposition) - decomposition))) + (if (or (> (length decomposition) 1) + (/= (car decomposition) char)) decomposition)))) (defun hfs-nfd (char) (when (or (and (>= char 0) (< char #x2000)) @@ -180,6 +183,9 @@ (setq ccc (ucs-normalize-ccc char)) (setq decomposition (get-char-code-property char 'decomposition)) + (if (and (= (length decomposition) 1) + (= (car decomposition) char)) + (setq decomposition nil)) (if (and ccc (/= 0 ccc)) (add-to-list 'combining-chars char)) (if (and (numberp (car decomposition)) (/= (ucs-normalize-ccc (car decomposition)) diff --git a/lisp/international/uni-bidi.el b/lisp/international/uni-bidi.el Binary files differindex e7682c6d8f..4d86fc821f 100644 --- a/lisp/international/uni-bidi.el +++ b/lisp/international/uni-bidi.el diff --git a/lisp/international/uni-category.el b/lisp/international/uni-category.el Binary files differindex a4455decc5..94b7c18b6e 100644 --- a/lisp/international/uni-category.el +++ b/lisp/international/uni-category.el diff --git a/lisp/international/uni-combining.el b/lisp/international/uni-combining.el Binary files differindex 227b9d0af7..1437ff9acb 100644 --- a/lisp/international/uni-combining.el +++ b/lisp/international/uni-combining.el diff --git a/lisp/international/uni-comment.el b/lisp/international/uni-comment.el Binary files differindex c9743064bd..21ccfe3ffe 100644 --- a/lisp/international/uni-comment.el +++ b/lisp/international/uni-comment.el diff --git a/lisp/international/uni-decimal.el b/lisp/international/uni-decimal.el Binary files differindex 2c424ffb5d..096257add2 100644 --- a/lisp/international/uni-decimal.el +++ b/lisp/international/uni-decimal.el diff --git a/lisp/international/uni-decomposition.el b/lisp/international/uni-decomposition.el Binary files differindex b0bf07bbe8..b9660cdab0 100644 --- a/lisp/international/uni-decomposition.el +++ b/lisp/international/uni-decomposition.el diff --git a/lisp/international/uni-digit.el b/lisp/international/uni-digit.el Binary files differindex fc52fd8c28..efb78b0e43 100644 --- a/lisp/international/uni-digit.el +++ b/lisp/international/uni-digit.el diff --git a/lisp/international/uni-lowercase.el b/lisp/international/uni-lowercase.el Binary files differindex 4189001820..7afd9503cb 100644 --- a/lisp/international/uni-lowercase.el +++ b/lisp/international/uni-lowercase.el diff --git a/lisp/international/uni-mirrored.el b/lisp/international/uni-mirrored.el Binary files differindex 006cf57559..e650166c24 100644 --- a/lisp/international/uni-mirrored.el +++ b/lisp/international/uni-mirrored.el diff --git a/lisp/international/uni-name.el b/lisp/international/uni-name.el Binary files differindex 7fac18b278..8b68163106 100644 --- a/lisp/international/uni-name.el +++ b/lisp/international/uni-name.el diff --git a/lisp/international/uni-numeric.el b/lisp/international/uni-numeric.el Binary files differindex d16e8c0087..a1865f1fb2 100644 --- a/lisp/international/uni-numeric.el +++ b/lisp/international/uni-numeric.el diff --git a/lisp/international/uni-old-name.el b/lisp/international/uni-old-name.el Binary files differindex 4e704e5cdd..de2d67b945 100644 --- a/lisp/international/uni-old-name.el +++ b/lisp/international/uni-old-name.el diff --git a/lisp/international/uni-titlecase.el b/lisp/international/uni-titlecase.el Binary files differindex b8098c8187..517edb2044 100644 --- a/lisp/international/uni-titlecase.el +++ b/lisp/international/uni-titlecase.el diff --git a/lisp/international/uni-uppercase.el b/lisp/international/uni-uppercase.el Binary files differindex 899276eb72..fcb22d7247 100644 --- a/lisp/international/uni-uppercase.el +++ b/lisp/international/uni-uppercase.el diff --git a/lisp/isearch.el b/lisp/isearch.el index 1942641fae..7fcc31f188 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -1191,19 +1191,17 @@ If first char entered is \\[isearch-yank-word-or-char], then do word search inst isearch-word isearch-new-word)) ;; Empty isearch-string means use default. - (if (= 0 (length isearch-string)) - (setq isearch-string (or (car (if isearch-regexp - regexp-search-ring - search-ring)) - "") - - isearch-message - (mapconcat 'isearch-text-char-description - isearch-string "")) - ;; This used to set the last search string, - ;; but I think it is not right to do that here. - ;; Only the string actually used should be saved. - )) + (when (= 0 (length isearch-string)) + (setq isearch-string (or (car (if isearch-regexp + regexp-search-ring + search-ring)) + "") + + isearch-message + (mapconcat 'isearch-text-char-description + isearch-string "")) + ;; After taking the last element, adjust ring to previous one. + (isearch-ring-adjust1 nil))) ;; This used to push the state as of before this C-s, but it adds ;; an inconsistent state where part of variables are from the @@ -1290,7 +1288,9 @@ Use `isearch-exit' to quit without signaling." isearch-message (mapconcat 'isearch-text-char-description isearch-string "") - isearch-case-fold-search isearch-last-case-fold-search)) + isearch-case-fold-search isearch-last-case-fold-search) + ;; After taking the last element, adjust ring to previous one. + (isearch-ring-adjust1 nil)) ;; If already have what to search for, repeat it. (or isearch-success (progn @@ -2071,7 +2071,7 @@ Isearch mode." () (set yank-pointer-name (setq yank-pointer - (mod (+ (or yank-pointer 0) + (mod (+ (or yank-pointer (if advance 0 -1)) (if advance -1 1)) length))) (setq isearch-string (nth yank-pointer ring) diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 637d10135f..40fbb07259 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -86,6 +86,11 @@ The default value would be \"smtp\" or 25." :type '(choice (integer :tag "Port") (string :tag "Service")) :group 'smtpmail) +(defcustom smtpmail-smtp-user nil + "User name to use when looking up credentials." + :type '(choice (const nil) string) + :group 'smtpmail) + (defcustom smtpmail-local-domain nil "Local domain name without a host name. If the function `system-name' returns the full internet address, @@ -490,6 +495,7 @@ The list is in preference order.") (auth-source-search :host host :port port + :user smtpmail-smtp-user :max 1 :require (and ask-for-password '(:user :secret)) @@ -499,6 +505,8 @@ The list is in preference order.") (save-function (and ask-for-password (plist-get auth-info :save-function))) ret) + (when (functionp password) + (setq password (funcall password))) (when (and user (not password)) ;; The user has stored the user name, but not the password, so @@ -510,6 +518,7 @@ The list is in preference order.") :max 1 :host host :port port + :user smtpmail-smtp-user :require '(:user :secret) :create t)) password (plist-get auth-info :secret))) @@ -593,8 +602,10 @@ The list is in preference order.") (push smtpmail-smtp-server ports)) (while (and (not smtpmail-smtp-server) (setq port (pop ports))) - (when (setq stream (ignore-errors - (open-network-stream "smtp" nil server port))) + (when (setq stream (condition-case () + (open-network-stream "smtp" nil server port) + (quit nil) + (error nil))) (customize-save-variable 'smtpmail-smtp-server server) (customize-save-variable 'smtpmail-smtp-service port) (delete-process stream))) @@ -615,8 +626,6 @@ The list is in preference order.") (and mail-specify-envelope-from (mail-envelope-from)) user-mail-address)) - (coding-system-for-read 'binary) - (coding-system-for-write 'binary) response-code process-buffer result @@ -635,21 +644,23 @@ The list is in preference order.") (erase-buffer)) ;; open the connection to the server - (setq result - (open-network-stream - "smtpmail" process-buffer host port - :type smtpmail-stream-type - :return-list t - :capability-command (format "EHLO %s\r\n" (smtpmail-fqdn)) - :end-of-command "^[0-9]+ .*\r\n" - :success "^2.*\n" - :always-query-capabilities t - :starttls-function - (lambda (capabilities) - (and (string-match "-STARTTLS" capabilities) - "STARTTLS\r\n")) - :client-certificate t - :use-starttls-if-possible t)) + (let ((coding-system-for-read 'binary) + (coding-system-for-write 'binary)) + (setq result + (open-network-stream + "smtpmail" process-buffer host port + :type smtpmail-stream-type + :return-list t + :capability-command (format "EHLO %s\r\n" (smtpmail-fqdn)) + :end-of-command "^[0-9]+ .*\r\n" + :success "^2.*\n" + :always-query-capabilities t + :starttls-function + (lambda (capabilities) + (and (string-match "-STARTTLS" capabilities) + "STARTTLS\r\n")) + :client-certificate t + :use-starttls-if-possible t))) ;; If we couldn't access the server at all, we give up. (unless (setq process (car result)) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index b82147b97f..313298de97 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1119,27 +1119,13 @@ It also eliminates runs of equal strings." `(display (space :align-to ,column))) nil)))) (if (not (consp str)) - (put-text-property (point) - (progn - (insert (bidi-string-mark-left-to-right - str)) - (point)) + (put-text-property (point) (progn (insert str) (point)) 'mouse-face 'highlight) - (put-text-property (point) - (progn - (insert - (bidi-string-mark-left-to-right - (car str))) - (point)) + (put-text-property (point) (progn (insert (car str)) (point)) 'mouse-face 'highlight) - (add-text-properties (point) - (progn - (insert - (bidi-string-mark-left-to-right - (cadr str))) - (point)) + (add-text-properties (point) (progn (insert (cadr str)) (point)) '(mouse-face nil - face completions-annotations))) + face completions-annotations))) (cond ((eq completions-format 'vertical) ;; Vertical format diff --git a/lisp/mpc.el b/lisp/mpc.el index 5319ea4389..932fb5926f 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -246,11 +246,12 @@ and HOST defaults to localhost." (process-put proc 'ready t) (unless (eq (match-end 0) (point-max)) (error "Unexpected trailing text")) - (let ((error (match-string 1))) + (let ((error-text (match-string 1))) (delete-region (point) (point-max)) (let ((callback (process-get proc 'callback))) (process-put proc 'callback nil) - (if error (signal 'mpc-proc-error error)) + (if error-text + (process-put proc 'mpc-proc-error error-text)) (funcall callback))))))))) (defun mpc--proc-connect (host) @@ -314,19 +315,23 @@ and HOST defaults to localhost." mpc-proc) (setq mpc-proc (mpc--proc-connect mpc-host)))) +(defun mpc-proc-check (proc) + (let ((error-text (process-get proc 'mpc-proc-error))) + (when error-text + (process-put proc 'mpc-proc-error nil) + (signal 'mpc-proc-error error-text)))) + (defun mpc-proc-sync (&optional proc) "Wait for MPC process until it is idle again. Return the buffer in which the process is/was running." (unless proc (setq proc (mpc-proc))) (unwind-protect - (condition-case err - (progn - (while (and (not (process-get proc 'ready)) - (accept-process-output proc))) - (if (process-get proc 'ready) (process-buffer proc) - ;; (delete-process proc) - (error "No response from MPD"))) - (error (message "MPC: %s" err) (signal (car err) (cdr err)))) + (progn + (while (and (not (process-get proc 'ready)) + (accept-process-output proc))) + (mpc-proc-check proc) + (if (process-get proc 'ready) (process-buffer proc) + (error "No response from MPD"))) (unless (process-get proc 'ready) ;; (debug) (message "Killing hung process") @@ -358,13 +363,13 @@ which will be concatenated with proper quoting before passing them to MPD." "\n"))) (if callback ;; (let ((buf (current-buffer))) - (process-put proc 'callback - callback - ;; (lambda () - ;; (funcall callback - ;; (prog1 (current-buffer) - ;; (set-buffer buf))))) - ) + (process-put proc 'callback + callback + ;; (lambda () + ;; (funcall callback + ;; (prog1 (current-buffer) + ;; (set-buffer buf))))) + ) ;; If `callback' is nil, we're executing synchronously. (process-put proc 'callback 'ignore) ;; This returns the process's buffer. diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index e18b42a275..f9bc13e1e2 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -1103,26 +1103,32 @@ URL in a new window." (interactive (browse-url-interactive-arg "URL: ")) (setq url (browse-url-encode-url url)) (let* ((process-environment (browse-url-process-environment)) + (use-remote + (not (memq system-type '(windows-nt ms-dos)))) (process (apply 'start-process (concat "firefox " url) nil browse-url-firefox-program (append browse-url-firefox-arguments - (if (memq system-type '(windows-nt ms-dos)) - (list url) - (list "-remote" - (concat "openURL(" - url - (if (browse-url-maybe-new-window - new-window) - (if browse-url-firefox-new-window-is-tab - ",new-tab" - ",new-window")) - ")"))))))) - (set-process-sentinel process - `(lambda (process change) - (browse-url-firefox-sentinel process ,url))))) + (if use-remote + (list "-remote" + (concat + "openURL(" + url + (if (browse-url-maybe-new-window new-window) + (if browse-url-firefox-new-window-is-tab + ",new-tab" + ",new-window")) + ")")) + (list url)))))) + ;; If we use -remote, the process exits with status code 2 if + ;; Firefox is not already running. The sentinel runs firefox + ;; directly if that happens. + (when use-remote + (set-process-sentinel process + `(lambda (process change) + (browse-url-firefox-sentinel process ,url)))))) (defun browse-url-firefox-sentinel (process url) "Handle a change to the process communicating with Firefox." diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 46a82e3720..bdf2dadd16 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -811,15 +811,19 @@ this is `comint-dynamic-complete-functions'." (while (< (point) end) (skip-chars-forward " \t\n") (push (point) begins) - (let ((skip t)) - (while skip - (skip-chars-forward "^ \t\n") - (if (eq (char-before) ?\\) - (skip-chars-forward " \t\n") - (setq skip nil)))) + (while + (progn + (skip-chars-forward "^ \t\n\\") + (when (eq (char-after) ?\\) + (forward-char 1) + (unless (eolp) + (forward-char 1) + t)))) (push (buffer-substring-no-properties (car begins) (point)) args)) (cons (nreverse args) (nreverse begins))))) +(make-obsolete 'pcomplete-parse-comint-arguments + 'comint-parse-pcomplete-arguments "24.1") (defun pcomplete-parse-arguments (&optional expand-p) "Parse the command line arguments. Most completions need this info." @@ -879,7 +883,7 @@ Magic characters are those in `pcomplete-arg-quote-list'." (or (run-hook-with-args-until-success 'pcomplete-quote-arg-hook filename index) (when (memq c pcomplete-arg-quote-list) - (string "\\" c)) + (string ?\\ c)) (char-to-string c)) (setq index (1+ index)))) filename diff --git a/lisp/proced.el b/lisp/proced.el index 94ea579ebd..e4987bd926 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -395,7 +395,7 @@ It is a list of lists (KEY PREDICATE REVERSE).") :group 'proced-faces) (defface proced-marked - '((t (:inherit font-lock-warning-face))) + '((t (:inherit error))) "Face used for marked processes." :group 'proced-faces) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 0d88f85d26..a1cbdc1656 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -6325,7 +6325,9 @@ comment at the start of cc-engine.el for more info." (let* ((start (point)) kwd-sym kwd-clause-end found-type) ;; Look for a specifier keyword clause. - (when (looking-at c-prefix-spec-kwds-re) + (when (or (looking-at c-prefix-spec-kwds-re) + (and (c-major-mode-is 'java-mode) + (looking-at "@[A-Za-z0-9]+"))) (if (looking-at c-typedef-key) (setq at-typedef t)) (setq kwd-sym (c-keyword-sym (match-string 1))) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 2277ba760a..3d5dc30d82 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -199,10 +199,16 @@ (set-face-foreground 'c-annotation-face "blue") (eval-and-compile - ;; We need the following functions during compilation since they're - ;; called when the `c-lang-defconst' initializers are evaluated. - ;; Define them at runtime too for the sake of derived modes. - + ;; We need the following definitions during compilation since they're + ;; used when the `c-lang-defconst' initializers are evaluated. Define + ;; them at runtime too for the sake of derived modes. + + ;; This indicates the "font locking context", and is set just before + ;; fontification is done. If non-nil, it says, e.g., point starts + ;; from within a #if preprocessor construct. + (defvar c-font-lock-context nil) + (make-variable-buffer-local 'c-font-lock-context) + (defmacro c-put-font-lock-face (from to face) ;; Put a face on a region (overriding any existing face) in the way ;; font-lock would do it. In XEmacs that means putting an @@ -283,6 +289,45 @@ nil))))) res)))) + (defun c-make-font-lock-search-form (regexp highlights) + ;; Return a lisp form which will fontify every occurence of REGEXP + ;; (a regular expression, NOT a function) between POINT and `limit' + ;; with HIGHLIGHTS, a list of highlighters as specified on page + ;; "Search-based Fontification" in the elisp manual. + `(while (re-search-forward ,regexp limit t) + (unless (progn + (goto-char (match-beginning 0)) + (c-skip-comments-and-strings limit)) + (goto-char (match-end 0)) + ,@(mapcar + (lambda (highlight) + (if (integerp (car highlight)) + ;; e.g. highlight is (1 font-lock-type-face t) + (progn + (unless (eq (nth 2 highlight) t) + (error + "The override flag must currently be t in %s" + highlight)) + (when (nth 3 highlight) + (error + "The laxmatch flag may currently not be set in %s" + highlight)) + `(save-match-data + (c-put-font-lock-face + (match-beginning ,(car highlight)) + (match-end ,(car highlight)) + ,(elt highlight 1)))) + ;; highlight is an "ANCHORED HIGHLIGHER" of the form + ;; (ANCHORED-MATCHER PRE-FORM POST-FORM SUBEXP-HIGHLIGHTERS...) + (when (nth 3 highlight) + (error "Match highlights currently not supported in %s" + highlight)) + `(progn + ,(nth 1 highlight) + (save-match-data ,(car highlight)) + ,(nth 2 highlight)))) + highlights)))) + (defun c-make-font-lock-search-function (regexp &rest highlights) ;; This function makes a byte compiled function that works much like ;; a matcher element in `font-lock-keywords'. It cuts out a little @@ -313,43 +358,101 @@ ;; lambda more easily. (byte-compile `(lambda (limit) - (let (;; The font-lock package in Emacs is known to clobber + (let ( ;; The font-lock package in Emacs is known to clobber ;; `parse-sexp-lookup-properties' (when it exists). (parse-sexp-lookup-properties (cc-eval-when-compile (boundp 'parse-sexp-lookup-properties)))) - (while (re-search-forward ,regexp limit t) - (unless (progn - (goto-char (match-beginning 0)) - (c-skip-comments-and-strings limit)) - (goto-char (match-end 0)) - ,@(mapcar - (lambda (highlight) - (if (integerp (car highlight)) - (progn - (unless (eq (nth 2 highlight) t) - (error - "The override flag must currently be t in %s" - highlight)) - (when (nth 3 highlight) - (error - "The laxmatch flag may currently not be set in %s" - highlight)) - `(save-match-data - (c-put-font-lock-face - (match-beginning ,(car highlight)) - (match-end ,(car highlight)) - ,(elt highlight 1)))) - (when (nth 3 highlight) - (error "Match highlights currently not supported in %s" - highlight)) - `(progn - ,(nth 1 highlight) - (save-match-data ,(car highlight)) - ,(nth 2 highlight)))) - highlights)))) + + ;; (while (re-search-forward ,regexp limit t) + ;; (unless (progn + ;; (goto-char (match-beginning 0)) + ;; (c-skip-comments-and-strings limit)) + ;; (goto-char (match-end 0)) + ;; ,@(mapcar + ;; (lambda (highlight) + ;; (if (integerp (car highlight)) + ;; (progn + ;; (unless (eq (nth 2 highlight) t) + ;; (error + ;; "The override flag must currently be t in %s" + ;; highlight)) + ;; (when (nth 3 highlight) + ;; (error + ;; "The laxmatch flag may currently not be set in %s" + ;; highlight)) + ;; `(save-match-data + ;; (c-put-font-lock-face + ;; (match-beginning ,(car highlight)) + ;; (match-end ,(car highlight)) + ;; ,(elt highlight 1)))) + ;; (when (nth 3 highlight) + ;; (error "Match highlights currently not supported in %s" + ;; highlight)) + ;; `(progn + ;; ,(nth 1 highlight) + ;; (save-match-data ,(car highlight)) + ;; ,(nth 2 highlight)))) + ;; highlights))) + ,(c-make-font-lock-search-form regexp highlights)) + nil))) + (defun c-make-font-lock-context-search-function (normal &rest state-stanzas) + ;; This function makes a byte compiled function that works much like + ;; a matcher element in `font-lock-keywords', with the following + ;; enhancement: the generated function will test for particular "font + ;; lock contexts" at the start of the region, i.e. is this point in + ;; the middle of some particular construct? if so the generated + ;; function will first fontify the tail of the construct, before + ;; going into the main loop and fontify full constructs up to limit. + ;; + ;; The generated function takes one parameter called `limit', and + ;; will fontify the region between POINT and LIMIT. + ;; + ;; NORMAL is a list of the form (REGEXP HIGHLIGHTS .....), and is + ;; used to fontify the "regular" bit of the region. + ;; STATE-STANZAS is list of elements of the form (STATE LIM REGEXP + ;; HIGHLIGHTS), each element coding one possible font lock context. + + ;; o - REGEXP is a font-lock regular expression (NOT a function), + ;; o - HIGHLIGHTS is a list of zero or more highlighters as defined + ;; on page "Search-based Fontification" in the elisp manual. As + ;; yet (2009-06), they must have OVERRIDE set, and may not have + ;; LAXMATCH set. + ;; + ;; o - STATE is the "font lock context" (e.g. in-cpp-expr) and is + ;; not quoted. + ;; o - LIM is a lisp form whose evaluation will yield the limit + ;; position in the buffer for fontification by this stanza. + ;; + ;; This function does not do any hidden buffer changes, but the + ;; generated functions will. (They are however used in places + ;; covered by the font-lock context.) + ;; + ;; Note: Replace `byte-compile' with `eval' to debug the generated + ;; lambda more easily. + (byte-compile + `(lambda (limit) + (let ( ;; The font-lock package in Emacs is known to clobber + ;; `parse-sexp-lookup-properties' (when it exists). + (parse-sexp-lookup-properties + (cc-eval-when-compile + (boundp 'parse-sexp-lookup-properties)))) + ,@(mapcar + (lambda (stanza) + (let ((state (car stanza)) + (lim (nth 1 stanza)) + (regexp (nth 2 stanza)) + (highlights (cdr (cddr stanza)))) + `(if (eq c-font-lock-context ',state) + (let ((limit ,lim)) + ,(c-make-font-lock-search-form + regexp highlights))))) + state-stanzas) + ,(c-make-font-lock-search-form (car normal) (cdr normal)) + nil)))) + ; (eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el. ; '(progn (def-edebug-spec c-fontify-types-and-refs let*) @@ -494,19 +597,24 @@ stuff. Used on level 1 and higher." (c-lang-const c-cpp-expr-directives))) (cef-re (c-make-keywords-re t (c-lang-const c-cpp-expr-functions)))) - `((,(c-make-font-lock-search-function - (concat noncontinued-line-end - (c-lang-const c-opt-cpp-prefix) - ced-re ; 1 + ncle-depth - ;; Match the whole logical line to look - ;; for the functions in. - "\\(\\\\\\(.\\|[\n\r]\\)\\|[^\n\r]\\)*") - `((let ((limit (match-end 0))) - (while (re-search-forward ,cef-re limit 'move) - (c-put-font-lock-face (match-beginning 1) - (match-end 1) - c-preprocessor-face-name))) - (goto-char (match-end ,(1+ ncle-depth))))))))) + + `((,(c-make-font-lock-context-search-function + `(,(concat noncontinued-line-end + (c-lang-const c-opt-cpp-prefix) + ced-re ; 1 + ncle-depth + ;; Match the whole logical line to look + ;; for the functions in. + "\\(\\\\\\(.\\|[\n\r]\\)\\|[^\n\r]\\)*") + ((let ((limit (match-end 0))) + (while (re-search-forward ,cef-re limit 'move) + (c-put-font-lock-face (match-beginning 1) + (match-end 1) + c-preprocessor-face-name))) + (goto-char (match-end ,(1+ ncle-depth))))) + `(in-cpp-expr + (save-excursion (c-end-of-macro) (point)) + ,cef-re + (1 c-preprocessor-face-name t))))))) ;; Fontify the directive names. (,(c-make-font-lock-search-function @@ -759,6 +867,12 @@ casts and declarations are fontified. Used on level 2 and higher." (c-forward-syntactic-ws limit) (c-font-lock-declarators limit t (eq prop 'c-decl-type-start)))) + (setq c-font-lock-context ;; (c-guess-font-lock-context) + (save-excursion + (if (and c-cpp-expr-intro-re + (c-beginning-of-macro) + (looking-at c-cpp-expr-intro-re)) + 'in-cpp-expr))) nil) (defun c-font-lock-<>-arglists (limit) @@ -1552,7 +1666,9 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'." (unless (c-skip-comments-and-strings limit) (c-forward-syntactic-ws) ;; Handle prefix declaration specifiers. - (when (looking-at c-prefix-spec-kwds-re) + (when (or (looking-at c-prefix-spec-kwds-re) + (and (c-major-mode-is 'java-mode) + (looking-at "@[A-Za-z0-9]+"))) (c-forward-keyword-clause 1)) ,(if (c-major-mode-is 'c++-mode) `(when (and (c-forward-type) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 35097242cb..279c5e46c4 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -815,6 +815,16 @@ expression." t (if (c-lang-const c-opt-cpp-prefix) '("if" "elif"))) +(c-lang-defconst c-cpp-expr-intro-re + "Regexp which matches the start of a CPP directive which contains an +expression, or nil if there aren't any in the language." + t (if (c-lang-const c-cpp-expr-directives) + (concat + (c-lang-const c-opt-cpp-prefix) + (c-make-keywords-re t (c-lang-const c-cpp-expr-directives))))) +(c-lang-defvar c-cpp-expr-intro-re + (c-lang-const c-cpp-expr-intro-re)) + (c-lang-defconst c-cpp-expr-functions "List of functions in cpp expressions." t (if (c-lang-const c-opt-cpp-prefix) @@ -1813,7 +1823,7 @@ will be handled." "bindsTo" "delegatesTo" "implements" "proxy" "storedOn") ;; Note: "const" is not used in Java, but it's still a reserved keyword. java '("abstract" "const" "final" "native" "private" "protected" "public" - "static" "strictfp" "synchronized" "transient" "volatile" "@[A-Za-z0-9]+") + "static" "strictfp" "synchronized" "transient" "volatile") pike '("final" "inline" "local" "nomask" "optional" "private" "protected" "public" "static" "variant")) @@ -1899,10 +1909,7 @@ one of `c-type-list-kwds', `c-ref-list-kwds', (c-lang-defconst c-prefix-spec-kwds-re ;; Adorned regexp of `c-prefix-spec-kwds'. - t (c-make-keywords-re t (c-lang-const c-prefix-spec-kwds)) - java (replace-regexp-in-string - "\\\\\\[" "[" - (replace-regexp-in-string "\\\\\\+" "+" (c-make-keywords-re t (c-lang-const c-prefix-spec-kwds))))) + t (c-make-keywords-re t (c-lang-const c-prefix-spec-kwds))) (c-lang-defvar c-prefix-spec-kwds-re (c-lang-const c-prefix-spec-kwds-re)) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index f3b873c8b1..79fec080d5 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -145,7 +145,7 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) (ant "^[ \t]*\\[[^] \n]+\\][ \t]*\\([^: \n]+\\):\\([0-9]+\\):\\(?:\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\):\\)?\ -\\( warning\\)?" 1 (2 . 4) (3 . 5) (4)) +\\( warning\\)?" 1 (2 . 4) (3 . 5) (6)) (bash "^\\([^: \n\t]+\\): line \\([0-9]+\\):" 1 2) @@ -523,7 +523,7 @@ you may also want to change `compilation-page-delimiter'.") ;; Command output lines. Recognize `make[n]:' lines too. ("^\\([[:alnum:]_/.+-]+\\)\\(\\[\\([0-9]+\\)\\]\\)?[ \t]*:" (1 font-lock-function-name-face) (3 compilation-line-face nil t)) - (" -\\(?:o[= ]?\\|-\\(?:outfile\\|output\\)[= ]\\)\\(\\S +\\)" . 1) + (" --?o\\(?:utfile\\|utput\\)?[= ]\\(\\S +\\)" . 1) ("^Compilation \\(finished\\).*" (0 '(face nil compilation-message nil help-echo nil mouse-face nil) t) (1 compilation-info-face)) @@ -985,12 +985,15 @@ POS and RES.") (let* ((prev (or (get-text-property (1- prev-pos) 'compilation-message) (get-text-property prev-pos 'compilation-message))) - (prev-struct - (car (nth 2 (car prev))))) + (prev-file-struct + (and prev + (compilation--loc->file-struct + (compilation--message->loc prev))))) + ;; Construct FILE . DIR from that. - (if prev-struct - (setq file (cons (car prev-struct) - (cadr prev-struct)))))) + (if prev-file-struct + (setq file (cons (caar prev-file-struct) + (cadr (car prev-file-struct))))))) (unless file (setq file '("*unknown*"))))) ;; All of these fields are optional, get them only if we have an index, and diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 31100f3fac..709f01444b 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -463,9 +463,12 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'." (set (make-local-variable 'compilation-exit-message-function) (lambda (status code msg) (if (eq status 'exit) - (cond ((zerop code) + ;; This relies on the fact that `compilation-start' + ;; sets buffer-modified to nil before running the command, + ;; so the buffer is still unmodified if there is no output. + (cond ((and (zerop code) (buffer-modified-p)) '("finished (matches found)\n" . "matched")) - ((= code 1) + ((or (= code 1) (not (buffer-modified-p))) '("finished with no matches found\n" . "no match")) (t (cons msg code))) diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index 4151e2bb79..470b309434 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -55,24 +55,24 @@ (defvar scheme-mode-syntax-table (let ((st (make-syntax-table)) (i 0)) - - ;; Default is atom-constituent. - (while (< i 256) + ;; Symbol constituents + ;; We used to treat chars 128-256 as symbol-constituent, but they + ;; should be valid word constituents (Bug#8843). Note that valid + ;; identifier characters are Scheme-implementation dependent. + (while (< i ?0) (modify-syntax-entry i "_ " st) (setq i (1+ i))) - - ;; Word components. - (setq i ?0) - (while (<= i ?9) - (modify-syntax-entry i "w " st) + (setq i (1+ ?9)) + (while (< i ?A) + (modify-syntax-entry i "_ " st) (setq i (1+ i))) - (setq i ?A) - (while (<= i ?Z) - (modify-syntax-entry i "w " st) + (setq i (1+ ?Z)) + (while (< i ?a) + (modify-syntax-entry i "_ " st) (setq i (1+ i))) - (setq i ?a) - (while (<= i ?z) - (modify-syntax-entry i "w " st) + (setq i (1+ ?z)) + (while (< i 128) + (modify-syntax-entry i "_ " st) (setq i (1+ i))) ;; Whitespace diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 31a4fbaef4..7b949134c6 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -460,6 +460,7 @@ This is buffer-local in every such buffer.") (define-key map "\C-c+" 'sh-add) (define-key map "\C-\M-x" 'sh-execute-region) (define-key map "\C-c\C-x" 'executable-interpret) + ;; FIXME: Use post-self-insert-hook. (define-key map "<" 'sh-maybe-here-document) (define-key map "(" 'skeleton-pair-insert-maybe) (define-key map "{" 'skeleton-pair-insert-maybe) @@ -3659,6 +3660,7 @@ The document is bounded by `sh-here-document-word'." (save-excursion (backward-char 2) (sh-quoted-p)) + (nth 8 (syntax-ppss)) (let ((tabs (if (string-match "\\`-" sh-here-document-word) (make-string (/ (current-indentation) tab-width) ?\t) "")) diff --git a/lisp/shell.el b/lisp/shell.el index de811543ba..01d1a688f0 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -383,6 +383,21 @@ to `dirtrack-mode'." :group 'shell :type '(choice (const nil) regexp)) +(defun shell-parse-pcomplete-arguments () + "Parse whitespace separated arguments in the current region." + (let ((begin (save-excursion (shell-backward-command 1) (point))) + (end (point)) + begins args) + (save-excursion + (goto-char begin) + (while (< (point) end) + (skip-chars-forward " \t\n") + (push (point) begins) + (looking-at "\\(?:[^\s\t\n\\]\\|'[^']*'\\|\"\\(?:[^\"\\]\\|\\\\.\\)*\"\\|\\\\.\\)*\\(?:\\\\\\|'[^']*\\|\"\\(?:[^\"\\]\\|\\\\.\\)*\\)?") + (goto-char (match-end 0)) + (push (buffer-substring-no-properties (car begins) (point)) + args)) + (cons (nreverse args) (nreverse begins))))) (defun shell-completion-vars () "Setup completion vars for `shell-mode' and `read-shell-command'." @@ -396,8 +411,9 @@ to `dirtrack-mode'." (set (make-local-variable 'comint-dynamic-complete-functions) shell-dynamic-complete-functions) (set (make-local-variable 'pcomplete-parse-arguments-function) - ;; FIXME: This function should be moved to shell.el. - #'pcomplete-parse-comint-arguments) + #'shell-parse-pcomplete-arguments) + (set (make-local-variable 'pcomplete-arg-quote-list) + (append "\\ \t\n\r\"'`$|&;(){}[]<>#" nil)) (set (make-local-variable 'pcomplete-termination-string) (cond ((not comint-completion-addsuffix) "") ((stringp comint-completion-addsuffix) diff --git a/lisp/startup.el b/lisp/startup.el index 0dee969fb5..6c3bb397e9 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -409,7 +409,7 @@ The regexp should not contain a starting \"\\`\" or a trailing \"\\'\"; those are added automatically by callers.") (defun normal-top-level-add-subdirs-to-load-path () - "Add all subdirectories of current directory to `load-path'. + "Add all subdirectories of `default-directory' to `load-path'. More precisely, this uses only the subdirectories whose names start with letters or digits; it excludes any subdirectory named `RCS' or `CVS', and any subdirectory that contains a file named `.nosearch'." diff --git a/lisp/term.el b/lisp/term.el index 6d7f6f5c53..361ff68539 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -1227,9 +1227,9 @@ without any interpretation." (make-string 1 char) (format "\e%c" char))))) -(defun term-mouse-paste (click arg) - "Insert the last stretch of killed text at the position clicked on." - (interactive "e\nP") +(defun term-mouse-paste (click) + "Insert the primary selection at the position clicked on." + (interactive "e") (if (featurep 'xemacs) (term-send-raw-string (or (condition-case () (x-get-selection) (error ())) @@ -1238,10 +1238,17 @@ without any interpretation." (run-hooks 'mouse-leave-buffer-hook) (setq this-command 'yank) (mouse-set-point click) - (term-send-raw-string (current-kill (cond - ((listp arg) 0) - ((eq arg '-) -1) - (t (1- arg))))))) + (term-send-raw-string + (or (cond ; From `mouse-yank-primary': + ((eq system-type 'windows-nt) + (or (x-get-selection 'PRIMARY) + (x-get-selection-value))) + ((fboundp 'x-get-selection-value) + (or (x-get-selection-value) + (x-get-selection 'PRIMARY))) + (t + (x-get-selection 'PRIMARY))) + (error "No selection is available"))))) (defun term-paste () "Insert the last stretch of killed text at point." diff --git a/lisp/tutorial.el b/lisp/tutorial.el index 77ef50843d..c57ec33d2e 100644 --- a/lisp/tutorial.el +++ b/lisp/tutorial.el @@ -253,7 +253,7 @@ LEFT and RIGHT are the elements to compare." ;; * INSERTING AND DELETING ;; C-u 8 * to insert ********. (delete-backward-char "\d") - (delete-forward-char [?\C-d]) + (delete-char [?\C-d]) (backward-kill-word [?\M-\d]) (kill-word [?\M-d]) (kill-line [?\C-k]) @@ -298,7 +298,7 @@ LEFT and RIGHT are the elements to compare." (isearch-backward [?\C-r]) ;; * MULTIPLE WINDOWS - (split-window-vertically [?\C-x ?2]) + (split-window-above-each-other [?\C-x ?2]) (scroll-other-window [?\C-\M-v]) (other-window [?\C-x ?o]) (find-file-other-window [?\C-x ?4 ?\C-f]) @@ -889,6 +889,11 @@ Run the Viper tutorial? ")) (search-forward ">>") (replace-match "]"))) (beginning-of-line) + ;; FIXME: if the window is not tall, and especially if the + ;; big red "NOTICE: The main purpose..." text has been + ;; inserted at the start of the buffer, the "type C-v to + ;; move to the next screen" might not be visible on the + ;; first screen (n < 0). How will the novice know what to do? (let ((n (- (window-height (selected-window)) (count-lines (point-min) (point)) 6))) @@ -897,7 +902,7 @@ Run the Viper tutorial? ")) ;; For a short gap, we don't need the [...] line, ;; so delete it. (delete-region (point) (progn (end-of-line) (point))) - (newline n)) + (if (> n 0) (newline n))) ;; Some people get confused by the large gap. (newline (/ n 2)) diff --git a/lisp/view.el b/lisp/view.el index 21479a70a7..be011d217f 100644 --- a/lisp/view.el +++ b/lisp/view.el @@ -576,9 +576,9 @@ current buffer. " (cond ((or all-windows view-exits-all-viewing-windows) (dolist (window (get-buffer-window-list)) - (quit-restore-window window))) + (quit-window nil window))) ((eq (window-buffer) (current-buffer)) - (quit-restore-window))) + (quit-window))) (when exit-action (funcall exit-action buffer)) diff --git a/lisp/window.el b/lisp/window.el index eca3dcb435..fb9d38c650 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -2272,7 +2272,7 @@ another frame still exists. Functions quitting a window and consequently affected by this variable are `switch-to-prev-buffer', `delete-windows-on', -`replace-buffer-in-windows' and `quit-restore-window'." +`replace-buffer-in-windows' and `quit-window'." :type '(choice (const :tag "Never" nil) (const :tag "Automatic" automatic) @@ -2907,21 +2907,17 @@ all window-local buffer lists." ;; Unrecord BUFFER in WINDOW. (unrecord-window-buffer window buffer))))) -(defun quit-restore-window (&optional window kill) - "Quit WINDOW in some way. -WINDOW must be a live window and defaults to the selected window. -Return nil. +(defun quit-window (&optional kill window) + "Quit WINDOW and bury its buffer. +WINDOW defaults to the selected window. +With a prefix argument, kill the buffer instead. According to information stored in WINDOW's `quit-restore' window parameter either \(1) delete WINDOW and its frame, \(2) delete WINDOW, \(3) restore the buffer previously displayed in WINDOW, or \(4) make WINDOW display some other buffer than the present -one. If non-nil, reset `quit-restore' parameter to nil. - -Optional argument KILL non-nil means in addition kill WINDOW's -buffer. If KILL is nil, put WINDOW's buffer at the end of the -buffer list. Interactively, KILL is the prefix argument." - (interactive "i\nP") +one. If non-nil, reset `quit-restore' parameter to nil." + (interactive "P") (setq window (window-normalize-live-window window)) (let ((buffer (window-buffer window)) (quit-restore (window-parameter window 'quit-restore)) @@ -2971,8 +2967,7 @@ buffer list. Interactively, KILL is the prefix argument." (switch-to-prev-buffer window 'bury-or-kill))) ;; Kill WINDOW's old-buffer if requested - (when kill (kill-buffer buffer)) - nil)) + (if kill (kill-buffer buffer)))) ;;; Splitting windows. (defsubst window-split-min-size (&optional horizontal) @@ -4763,8 +4758,10 @@ BUFFER, nil if none was found." (dolist (window (window-list-1 nil 'nomini method-frame)) (let ((window-buffer (window-buffer window))) (when (and (not (window-minibuffer-p window)) - ;; Don't reuse a side window. - (or (not (eq (window-parameter window 'window-side) 'side)) + ;; Don't reuse a side window unless it shows the + ;; buffer already. + (or (memq (window-parameter window 'window-side) + '(nil none)) (eq window-buffer buffer)) (or (not method-window) (and (eq method-window 'same) @@ -5033,7 +5030,8 @@ description." ;; and must be neither a minibuffer window (not (window-minibuffer-p window)) ;; nor a side window. - (not (eq (window-parameter window 'window-side) 'side))) + (memq (window-parameter window 'window-side) + '(nil none))) (setq window (cond ((memq side display-buffer-side-specifiers) @@ -6079,9 +6077,6 @@ ignored. See also `same-window-regexps'." :type '(repeat (string :format "%v")) :group 'windows) -;; (make-obsolete-variable - ;; 'same-window-buffer-names - ;; "use 2nd arg of `display-buffer' instead." "24.1") (defcustom same-window-regexps nil "List of regexps saying which buffers should appear in the \"same\" window. @@ -6097,9 +6092,6 @@ the buffer name. This is for compatibility with See also `same-window-buffer-names'." :type '(repeat (regexp :format "%v")) :group 'windows) -;; (make-obsolete-variable - ;; 'same-window-regexps - ;; "use 2nd arg of `display-buffer' instead." "24.1") (defun same-window-p (buffer-name) "Return non-nil if a buffer named BUFFER-NAME would be shown in the \"same\" window. @@ -6124,8 +6116,6 @@ selected rather than \(as usual\) some other window. See (and (consp regexp) (stringp (car regexp)) (string-match-p (car regexp) buffer-name))) (throw 'found t)))))))) -;; (make-obsolete - ;; 'same-window-p "pass argument to buffer display function instead." "24.1") (defcustom special-display-frame-alist '((height . 14) (width . 80) (unsplittable . t)) @@ -6143,9 +6133,6 @@ These supersede the values given in `default-frame-alist'." (symbol :tag "Parameter") (sexp :tag "Value"))) :group 'frames) -;; (make-obsolete-variable - ;; 'special-display-frame-alist - ;; "use 2nd arg of `display-buffer' instead." "24.1") (defun special-display-popup-frame (buffer &optional args) "Display BUFFER in a special frame and return the window chosen. @@ -6191,9 +6178,6 @@ and (cdr ARGS) as the rest of the arguments." (set-window-buffer (frame-selected-window frame) buffer) (set-window-dedicated-p (frame-selected-window frame) t) (frame-selected-window frame)))))) -;; (make-obsolete - ;; 'special-display-popup-frame - ;; "use 2nd arg of `display-buffer' instead." "24.1") (defcustom special-display-function 'special-display-popup-frame "Function to call for displaying special buffers. @@ -6210,9 +6194,6 @@ A buffer is special when its name is either listed in :type 'function :group 'windows :group 'frames) -;; (make-obsolete-variable - ;; 'special-display-function - ;; "use 2nd arg of `display-buffer' instead." "24.1") (defcustom special-display-buffer-names nil "List of names of buffers that should be displayed specially. @@ -6277,9 +6258,6 @@ See also `special-display-regexps'." (repeat :tag "Arguments" (sexp))))) :group 'windows :group 'frames) -;; (make-obsolete-variable - ;; 'special-display-buffer-names - ;; "use 2nd arg of `display-buffer' instead." "24.1") ;;;###autoload (put 'special-display-buffer-names 'risky-local-variable t) @@ -6348,9 +6326,6 @@ See also `special-display-buffer-names'." (repeat :tag "Arguments" (sexp))))) :group 'windows :group 'frames) -;; (make-obsolete-variable - ;; 'special-display-regexps - ;; "use 2nd arg of `display-buffer' instead." "24.1") (defun special-display-p (buffer-name) "Return non-nil if a buffer named BUFFER-NAME gets a special frame. @@ -6378,9 +6353,6 @@ entry." ((and (consp regexp) (stringp (car regexp)) (string-match-p (car regexp) buffer-name)) (throw 'found (cdr regexp)))))))))) -;; (make-obsolete - ;; 'special-display-p - ;; "pass argument to buffer display function instead." "24.1") (defcustom pop-up-frame-alist nil "Alist of parameters for automatically generated new frames. @@ -6400,9 +6372,6 @@ affected by this variable." (symbol :tag "Parameter") (sexp :tag "Value"))) :group 'frames) -;; (make-obsolete-variable - ;; 'pop-up-frame-alist - ;; "use 2nd arg of `display-buffer' instead." "24.1") (defcustom pop-up-frame-function (lambda () (make-frame pop-up-frame-alist)) @@ -6412,9 +6381,6 @@ frame. The default value calls `make-frame' with the argument `pop-up-frame-alist'." :type 'function :group 'frames) -;; (make-obsolete-variable - ;; 'pop-up-frame-function - ;; "use 2nd arg of `display-buffer' instead." "24.1") (defcustom pop-up-frames nil "Whether `display-buffer' should make a separate frame. @@ -6428,9 +6394,6 @@ Any other non-nil value means always make a separate frame." (const :tag "Always" t)) :group 'windows :group 'frames) -;; (make-obsolete-variable - ;; 'pop-up-frames - ;; "use 2nd arg of `display-buffer' instead." "24.1") (defcustom display-buffer-reuse-frames nil "Set and non-nil means `display-buffer' should reuse frames. @@ -6440,17 +6403,11 @@ that frame." :version "21.1" :group 'windows :group 'frames) -;; (make-obsolete-variable - ;; 'display-buffer-reuse-frames - ;; "use 2nd arg of `display-buffer' instead." "24.1") (defcustom pop-up-windows t "Non-nil means `display-buffer' should make a new window." :type 'boolean :group 'windows) -;; (make-obsolete-variable - ;; 'pop-up-windows - ;; "use 2nd arg of `display-buffer' instead." "24.1") (defcustom split-window-preferred-function 'split-window-sensibly "Function called by `display-buffer' to split a window. @@ -6477,9 +6434,6 @@ not want to split the selected window." :type 'function :version "23.1" :group 'windows) -;; (make-obsolete-variable - ;; 'split-window-preferred-function - ;; "use 2nd arg of `display-buffer' instead." "24.1") (defcustom split-height-threshold 80 "Minimum height for splitting a window to display a buffer. @@ -6491,9 +6445,6 @@ split it vertically disregarding the value of this variable." :type '(choice (const nil) (integer :tag "lines")) :version "23.1" :group 'windows) -;; (make-obsolete-variable - ;; 'split-height-threshold - ;; "use 2nd arg of `display-buffer' instead." "24.1") (defcustom split-width-threshold 160 "Minimum width for splitting a window to display a buffer. @@ -6503,9 +6454,6 @@ is nil, `display-buffer' cannot split windows horizontally." :type '(choice (const nil) (integer :tag "columns")) :version "23.1" :group 'windows) -;; (make-obsolete-variable - ;; 'split-width-threshold - ;; "use 2nd arg of `display-buffer' instead." "24.1") (defcustom even-window-heights t "If non-nil `display-buffer' will try to even window heights. @@ -6514,17 +6462,11 @@ alone. Heights are evened only when `display-buffer' chooses a window that appears above or below the selected window." :type 'boolean :group 'windows) -;; (make-obsolete-variable - ;; 'even-window-heights - ;; "use 2nd arg of `display-buffer' instead." "24.1") (defvar display-buffer-mark-dedicated nil "Non-nil means `display-buffer' marks the windows it creates as dedicated. The actual non-nil value of this variable will be copied to the `window-dedicated-p' flag.") -;; (make-obsolete-variable - ;; 'display-buffer-mark-dedicated - ;; "use 2nd arg of `display-buffer' instead." "24.1") (defun window-splittable-p (window &optional horizontal) "Return non-nil if `split-window-sensibly' may split WINDOW. @@ -6575,8 +6517,6 @@ hold: (max split-height-threshold (* 2 (max window-min-height (if mode-line-format 2 1)))))))))) -;; (make-obsolete - ;; 'window-splittable-p "use 2nd arg of `display-buffer' instead." "24.1") (defun split-window-sensibly (window) "Split WINDOW in a way suitable for `display-buffer'. @@ -6626,8 +6566,6 @@ split." (when (with-no-warnings (window-splittable-p window)) (with-selected-window window (split-window-vertically))))))) -;; (make-obsolete - ;; 'split-window-sensibly "use 2nd arg of `display-buffer' instead." "24.1") ;; Functions for converting Emacs 23 buffer display options to buffer ;; display specifiers. @@ -7102,39 +7040,6 @@ Return non-nil if the window was shrunk, nil otherwise." (with-current-buffer buffer-to-kill (remove-hook 'kill-buffer-hook delete-window-hook t)))))) -(defun quit-window (&optional kill window) - "Quit WINDOW and bury its buffer. -With a prefix argument, kill the buffer instead. WINDOW defaults -to the selected window. - -If WINDOW is non-nil, dedicated, or a minibuffer window, delete -it and, if it's alone on its frame, its frame too. Otherwise, or -if deleting WINDOW fails in any of the preceding cases, display -another buffer in WINDOW using `switch-to-buffer'. - -Optional argument KILL non-nil means kill WINDOW's buffer. -Otherwise, bury WINDOW's buffer, see `bury-buffer'." - (interactive "P") - (let ((buffer (window-buffer window))) - (if (or window - (window-minibuffer-p window) - (window-dedicated-p window)) - ;; WINDOW is either non-nil, a minibuffer window, or dedicated; - ;; try to delete it. - (let* ((window (or window (selected-window))) - (frame (window-frame window))) - (if (frame-root-window-p window) - ;; WINDOW is alone on its frame. - (delete-frame frame) - ;; There are other windows on its frame, delete WINDOW. - (delete-window window))) - ;; Otherwise, switch to another buffer in the selected window. - (switch-to-buffer nil)) - - ;; Deal with the buffer. - (if kill - (kill-buffer buffer) - (bury-buffer buffer)))) (defvar recenter-last-op nil "Indicates the last recenter operation performed. @@ -7531,6 +7436,8 @@ Otherwise, consult the value of `truncate-partial-width-windows' (< (window-width window) t-p-w-w) t-p-w-w)))) +;; Some of these are in tutorial--default-keys, so update that if you +;; change these. (define-key ctl-x-map "0" 'delete-window) (define-key ctl-x-map "1" 'delete-other-windows) (define-key ctl-x-map "2" 'split-window-above-each-other) diff --git a/src/ChangeLog b/src/ChangeLog index 922a8a33a9..49d5325c22 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,4 +1,4 @@ -2011-08-19 Paul Eggert <[email protected]> +2011-08-24 Paul Eggert <[email protected]> Integer and memory overflow issues (Bug#9196). @@ -422,6 +422,77 @@ (gs_load): Use printmax_t to print the widest integers possible. Check for integer overflow when computing image height and width. +2011-08-24 Eli Zaretskii <[email protected]> + + * xdisp.c (Fcurrent_bidi_paragraph_direction): For unibyte + buffers, return left-to-right. + (set_cursor_from_row): Consider candidate row a win if its glyph + represents a newline and point is on that newline. Fixes cursor + positioning on the newline at EOL of R2L text within L2R + paragraph, and vice versa. + (try_cursor_movement): Check continued rows, in addition to + continuation rows. Fixes unwarranted scroll when point enters a + continued line of R2L text within an L2R paragraph, or vice versa. + (cursor_row_p): Consider the case of point being equal to + MATRIX_ROW_END_CHARPOS. Prevents cursor being stuck when moving + from the end of a short line to the beginning of a continued line + of R2L text within L2R paragraph. + (RECORD_MAX_MIN_POS): For max_pos, use IT_CHARPOS even for + composed characters. + + * bidi.c (bidi_check_type): Use xassert. + (bidi_cache_iterator_state): Update the disp_pos and disp_prop_p + members. + +2011-08-23 Eli Zaretskii <[email protected]> + + * bidi.c (bidi_get_type): Abort if we get zero as the bidi type of + a character. + +2011-08-23 Chong Yidong <[email protected]> + + * nsfont.m (ns_otf_to_script): Fix typo. + +2011-08-22 Kenichi Handa <[email protected]> + + * chartab.c (Fset_char_table_extra_slot): Do not inhibit setting a + extra slot even if the purpose is char-code-property-table. + +2011-08-23 Eli Zaretskii <[email protected]> + + * xdisp.c (redisplay_window): When computing centering_position, + account for the height of the header line. (Bug#8874) + + * dispnew.c (buffer_posn_from_coords): Use buf_charpos_to_bytepos + instead of CHAR_TO_BYTE. Fixes a crash when a completion + candidate is selected by the mouse, and that candidate has a + composed character under the mouse. + + * xdisp.c (x_produce_glyphs): Set it->nglyphs to 1. Fixes pixel + coordinates reported by pos-visible-in-window-p for a composed + character in column zero. + +2011-08-23 Stefan Monnier <[email protected]> + + * cmds.c (Fself_insert_command): Mention post-self-insert-hook. + +2011-08-22 Eli Zaretskii <[email protected]> + + * xdisp.c (BUFFER_POS_REACHED_P): If this is a composition, + consider it a hit if to_charpos is anywhere in the range of the + composed buffer positions. + +2011-08-22 Chong Yidong <[email protected]> + + * image.c (gif_load): Don't assume that each subimage has the same + dimensions as the base image. Handle disposal method that is + "undefined" by the gif spec (Bug#9335). + +2011-08-20 Chong Yidong <[email protected]> + + * eval.c (Fsignal): Handle `debug' symbol in error handler (Bug#9329). + (Fcondition_case): Document `debug' symbol in error handler. + 2011-08-19 Eli Zaretskii <[email protected]> * xfaces.c (face_at_buffer_position): Avoid repeated evaluation of @@ -452,8 +523,8 @@ 2011-08-17 Chong Yidong <[email protected]> * eval.c (internal_condition_case, internal_condition_case_1) - (internal_condition_case_2, internal_condition_case_n): Remove - unnecessary aborts (Bug#9081). + (internal_condition_case_2, internal_condition_case_n): + Remove unnecessary aborts (Bug#9081). 2011-08-17 Eli Zaretskii <[email protected]> @@ -476,8 +547,8 @@ * unexcw.c ( __malloc_initialized): Declare external variable. (fixup_executable): Force the dumped emacs to reinitialize malloc. - * gmalloc.c [CYGWIN] (bss_sbrk_heapbase, bss_sbrk_heapinfo): New - variables. + * gmalloc.c [CYGWIN] (bss_sbrk_heapbase, bss_sbrk_heapinfo): + New variables. (malloc_initialize_1) [CYGWIN]: Prepare for reinitializing the dumped emacs. (_free_internal_nolock) [CYGWIN]: Ignore requests to free storage @@ -579,8 +650,8 @@ * xdisp.c (iterate_out_of_display_property): xassert that IT->position is set to within IT->object's boundaries. Break from the loop as soon as EOB is reached; avoids infloops in redisplay - when IT->position is set up wrongly due to some bug. Set - IT->current to match the bidi iterator unconditionally. + when IT->position is set up wrongly due to some bug. + Set IT->current to match the bidi iterator unconditionally. (push_display_prop): Allow GET_FROM_STRING as IT->method on entry. Force push_it to save on the stack the current buffer/string position, to be restored by pop_it. Fix flags in @@ -603,8 +674,8 @@ 2011-08-08 Eli Zaretskii <[email protected]> * xdisp.c (forward_to_next_line_start): Allow to use the - no-display-properties-and-no-overlays under bidi display. Set - disp_pos in the bidi iterator to avoid searches for display + no-display-properties-and-no-overlays under bidi display. + Set disp_pos in the bidi iterator to avoid searches for display properties and overlays. 2011-08-08 Chong Yidong <[email protected]> @@ -642,7 +713,7 @@ * bidi.c <bidi_cache_total_alloc>: Now static. (bidi_initialize): Initialize bidi_cache_total_alloc. - *xdisp.c (display_line): Release buffer allocated for shelved bidi + * xdisp.c (display_line): Release buffer allocated for shelved bidi cache. (Bug#9221) * bidi.c (bidi_shelve_cache, bidi_unshelve_cache): Track total diff --git a/src/bidi.c b/src/bidi.c index 769a14f089..433c2cea2d 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -108,8 +108,12 @@ bidi_get_type (int ch, bidi_dir_t override) abort (); default_type = (bidi_type_t) XINT (CHAR_TABLE_REF (bidi_type_table, ch)); - if (default_type == 0) - default_type = STRONG_L; + /* Every valid character code, even those that are unassigned by the + UCD, have some bidi-class property, according to + DerivedBidiClass.txt file. Therefore, if we ever get UNKNOWN_BT + (= zero) code from CHAR_TABLE_REF, that's a bug. */ + if (default_type == UNKNOWN_BT) + abort (); if (override == NEUTRAL_DIR) return default_type; @@ -142,11 +146,10 @@ bidi_get_type (int ch, bidi_dir_t override) } } -static void +static inline void bidi_check_type (bidi_type_t type) { - if (type < UNKNOWN_BT || type > NEUTRAL_ON) - abort (); + xassert (UNKNOWN_BT <= type && type <= NEUTRAL_ON); } /* Given a bidi TYPE of a character, return its category. */ @@ -549,6 +552,8 @@ bidi_cache_iterator_state (struct bidi_it *bidi_it, int resolved) bidi_cache[idx].next_for_neutral = bidi_it->next_for_neutral; bidi_cache[idx].next_for_ws = bidi_it->next_for_ws; bidi_cache[idx].ignore_bn_limit = bidi_it->ignore_bn_limit; + bidi_cache[idx].disp_pos = bidi_it->disp_pos; + bidi_cache[idx].disp_prop_p = bidi_it->disp_prop_p; } bidi_cache_last_idx = idx; diff --git a/src/chartab.c b/src/chartab.c index 0cabaac4cf..1d4ac04312 100644 --- a/src/chartab.c +++ b/src/chartab.c @@ -589,8 +589,6 @@ DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot, (Lisp_Object char_table, Lisp_Object n, Lisp_Object value) { CHECK_CHAR_TABLE (char_table); - if (EQ (XCHAR_TABLE (char_table)->purpose, Qchar_code_property_table)) - error ("Can't change extra-slot of char-code-property-table"); CHECK_NUMBER (n); if (XINT (n) < 0 || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table))) diff --git a/src/cmds.c b/src/cmds.c index 2feaf313f2..5a155ac77a 100644 --- a/src/cmds.c +++ b/src/cmds.c @@ -271,7 +271,8 @@ Whichever character you type to run this command is inserted. Before insertion, `expand-abbrev' is executed if the inserted character does not have word syntax and the previous character in the buffer does. After insertion, the value of `auto-fill-function' is called if the -`auto-fill-chars' table has a non-nil value for the inserted character. */) +`auto-fill-chars' table has a non-nil value for the inserted character. +At the end, it runs `post-self-insert-hook'. */) (Lisp_Object n) { int remove_boundary = 1; diff --git a/src/dispnew.c b/src/dispnew.c index 5fedbb75a3..e96583e002 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -5314,7 +5314,8 @@ buffer_posn_from_coords (struct window *w, int *x, int *y, struct display_pos *p if (STRINGP (it.string)) BYTEPOS (pos->pos) = string_char_to_byte (string, CHARPOS (pos->pos)); else - BYTEPOS (pos->pos) = CHAR_TO_BYTE (CHARPOS (pos->pos)); + BYTEPOS (pos->pos) = buf_charpos_to_bytepos (XBUFFER (w->buffer), + CHARPOS (pos->pos)); } #ifdef HAVE_WINDOW_SYSTEM diff --git a/src/eval.c b/src/eval.c index 8149683a10..e722b53fb7 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1358,8 +1358,12 @@ A handler is applicable to an error if CONDITION-NAME is one of the error's condition names. If an error happens, the first applicable handler is run. -The car of a handler may be a list of condition names -instead of a single condition name. Then it handles all of them. +The car of a handler may be a list of condition names instead of a +single condition name; then it handles all of them. If the special +condition name `debug' is present in this list, it allows another +condition in the list to run the debugger if `debug-on-error' and the +other usual mechanisms says it should (otherwise, `condition-case' +suppresses the debugger). When a handler handles an error, control returns to the `condition-case' and it executes the handler's BODY... @@ -1700,6 +1704,10 @@ See also the function `condition-case'. */) && (!NILP (Vdebug_on_signal) /* If no handler is present now, try to run the debugger. */ || NILP (clause) + /* A `debug' symbol in the handler list disables the normal + suppression of the debugger. */ + || (CONSP (clause) && CONSP (XCAR (clause)) + && !NILP (Fmemq (Qdebug, XCAR (clause)))) /* Special handler that means "print a message and run debugger if requested". */ || EQ (h->handler, Qerror))) diff --git a/src/image.c b/src/image.c index d10fdad1c5..d0d28bea58 100644 --- a/src/image.c +++ b/src/image.c @@ -7147,7 +7147,6 @@ gif_load (struct frame *f, struct image *img) ColorMapObject *gif_color_map; unsigned long pixel_colors[256]; GifFileType *gif; - int image_height, image_width; gif_memory_source memsrc; Lisp_Object specified_bg = image_spec_value (img->spec, QCbackground, NULL); Lisp_Object specified_file = image_spec_value (img->spec, QCfile, NULL); @@ -7224,19 +7223,13 @@ gif_load (struct frame *f, struct image *img) } } - img->corners[TOP_CORNER] = gif->SavedImages[idx].ImageDesc.Top; - img->corners[LEFT_CORNER] = gif->SavedImages[idx].ImageDesc.Left; - image_height = gif->SavedImages[idx].ImageDesc.Height; - img->corners[BOT_CORNER] = img->corners[TOP_CORNER] + image_height; - image_width = gif->SavedImages[idx].ImageDesc.Width; - img->corners[RIGHT_CORNER] = img->corners[LEFT_CORNER] + image_width; + width = img->width = gif->SWidth; + height = img->height = gif->SHeight; - width = img->width = max (gif->SWidth, - max (gif->Image.Left + gif->Image.Width, - img->corners[RIGHT_CORNER])); - height = img->height = max (gif->SHeight, - max (gif->Image.Top + gif->Image.Height, - img->corners[BOT_CORNER])); + img->corners[TOP_CORNER] = gif->SavedImages[0].ImageDesc.Top; + img->corners[LEFT_CORNER] = gif->SavedImages[0].ImageDesc.Left; + img->corners[BOT_CORNER] = img->corners[TOP_CORNER] + height; + img->corners[RIGHT_CORNER] = img->corners[LEFT_CORNER] + width; if (!check_image_size (f, width, height)) { @@ -7291,6 +7284,10 @@ gif_load (struct frame *f, struct image *img) unsigned char *raster = (unsigned char *) subimage->RasterBits; int transparency_color_index = -1; int disposal = 0; + int subimg_width = subimage->ImageDesc.Width; + int subimg_height = subimage->ImageDesc.Height; + int subimg_top = subimage->ImageDesc.Top; + int subimg_left = subimage->ImageDesc.Left; /* Find the Graphic Control Extension block for this sub-image. Extract the disposal method and transparency color. */ @@ -7314,6 +7311,13 @@ gif_load (struct frame *f, struct image *img) if (j == 0) disposal = 2; + /* For disposal == 0, the spec says "No disposal specified. The + decoder is not required to take any action." In practice, it + seems we need to treat this like "keep in place", see e.g. + http://upload.wikimedia.org/wikipedia/commons/3/37/Clock.gif */ + if (disposal == 0) + disposal = 1; + /* Allocate subimage colors. */ memset (pixel_colors, 0, sizeof pixel_colors); gif_color_map = subimage->ImageDesc.ColorMap; @@ -7341,34 +7345,34 @@ gif_load (struct frame *f, struct image *img) int row, pass; for (y = 0, row = interlace_start[0], pass = 0; - y < image_height; + y < subimg_height; y++, row += interlace_increment[pass]) { - if (row >= image_height) + if (row >= subimg_height) { row = interlace_start[++pass]; - while (row >= image_height) + while (row >= subimg_height) row = interlace_start[++pass]; } - for (x = 0; x < image_width; x++) + for (x = 0; x < subimg_width; x++) { - int c = raster[y * image_width + x]; + int c = raster[y * subimg_width + x]; if (transparency_color_index != c || disposal != 1) - XPutPixel (ximg, x + img->corners[LEFT_CORNER], - row + img->corners[TOP_CORNER], pixel_colors[c]); + XPutPixel (ximg, x + subimg_left, row + subimg_top, + pixel_colors[c]); } } } else { - for (y = 0; y < image_height; ++y) - for (x = 0; x < image_width; ++x) + for (y = 0; y < subimg_height; ++y) + for (x = 0; x < subimg_width; ++x) { - int c = raster[y * image_width + x]; + int c = raster[y * subimg_width + x]; if (transparency_color_index != c || disposal != 1) - XPutPixel (ximg, x + img->corners[LEFT_CORNER], - y + img->corners[TOP_CORNER], pixel_colors[c]); + XPutPixel (ximg, x + subimg_left, y + subimg_top, + pixel_colors[c]); } } } diff --git a/src/nsfont.m b/src/nsfont.m index 60f8c5321a..c4d9123fae 100644 --- a/src/nsfont.m +++ b/src/nsfont.m @@ -303,7 +303,7 @@ static NSString { Lisp_Object script = assq_no_quit (XCAR (otf), Votf_script_alist); return CONSP (script) - ? [NSString stringWithUTF8String: SDATA (SYMBOL_NAME XCDR ((script)))] + ? [NSString stringWithUTF8String: SDATA (SYMBOL_NAME (XCDR ((script))))] : @""; } diff --git a/src/process.c b/src/process.c index 08da53b4a4..a808832214 100644 --- a/src/process.c +++ b/src/process.c @@ -5161,6 +5161,9 @@ read_process_output (Lisp_Object proc, register int channel) p->decoding_carryover = coding->carryover_bytes; } if (SBYTES (text) > 0) + /* FIXME: It's wrong to wrap or not based on debug-on-error, and + sometimes it's simply wrong to wrap (e.g. when called from + accept-process-output). */ internal_condition_case_1 (read_process_output_call, Fcons (outstream, Fcons (proc, Fcons (text, Qnil))), diff --git a/src/xdisp.c b/src/xdisp.c index 86ad523dfd..e7aee09682 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -7696,7 +7696,12 @@ move_it_in_display_line_to (struct it *it, ((op & MOVE_TO_POS) != 0 \ && BUFFERP (it->object) \ && (IT_CHARPOS (*it) == to_charpos \ - || (!it->bidi_p && IT_CHARPOS (*it) > to_charpos)) \ + || (!it->bidi_p && IT_CHARPOS (*it) > to_charpos) \ + || (it->what == IT_COMPOSITION \ + && ((IT_CHARPOS (*it) > to_charpos \ + && to_charpos >= it->cmp_it.charpos) \ + || (IT_CHARPOS (*it) < to_charpos \ + && to_charpos <= it->cmp_it.charpos)))) \ && (it->method == GET_FROM_BUFFER \ || (it->method == GET_FROM_DISPLAY_VECTOR \ && it->dpvec + it->current.dpvec_index + 1 >= it->dpend))) @@ -13789,7 +13794,14 @@ set_cursor_from_row (struct window *w, struct glyph_row *row, && glyph->charpos != pt_old))))) return 0; /* If this candidate gives an exact match, use that. */ - if (!(BUFFERP (glyph->object) && glyph->charpos == pt_old) + if (!((BUFFERP (glyph->object) && glyph->charpos == pt_old) + /* If this candidate is a glyph created for the + terminating newline of a line, and point is on that + newline, it wins because it's an exact match. */ + || (!row->continued_p + && INTEGERP (glyph->object) + && glyph->charpos == 0 + && pt_old == MATRIX_ROW_END_CHARPOS (row) - 1)) /* Otherwise, keep the candidate that comes from a row spanning less buffer positions. This may win when one or both candidate positions are on glyphs that came from @@ -14571,7 +14583,8 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste } ++row; } - while ((MATRIX_ROW_CONTINUATION_LINE_P (row) + while (((MATRIX_ROW_CONTINUATION_LINE_P (row) + || row->continued_p) && MATRIX_ROW_BOTTOM_Y (row) <= last_y) || (MATRIX_ROW_START_CHARPOS (row) == PT && MATRIX_ROW_BOTTOM_Y (row) < last_y)); @@ -15237,7 +15250,8 @@ redisplay_window (Lisp_Object window, int just_this_one_p) if (pt_offset) centering_position -= pt_offset; centering_position -= - FRAME_LINE_HEIGHT (f) * (1 + margin + (last_line_misfit != 0)); + FRAME_LINE_HEIGHT (f) * (1 + margin + (last_line_misfit != 0)) + + WINDOW_HEADER_LINE_HEIGHT (w); /* Don't let point enter the scroll margin near top of the window. */ if (centering_position < margin * FRAME_LINE_HEIGHT (f)) @@ -18001,7 +18015,8 @@ cursor_row_p (struct glyph_row *row) { int result = 1; - if (PT == CHARPOS (row->end.pos)) + if (PT == CHARPOS (row->end.pos) + || PT == MATRIX_ROW_END_CHARPOS (row)) { /* Suppose the row ends on a string. Unless the row is continued, that means it ends on a newline @@ -18396,10 +18411,10 @@ display_line (struct it *it) min_pos = current_pos; \ min_bpos = current_bpos; \ } \ - if (current_pos > max_pos) \ + if (IT_CHARPOS (*it) > max_pos) \ { \ - max_pos = current_pos; \ - max_bpos = current_bpos; \ + max_pos = IT_CHARPOS (*it); \ + max_bpos = IT_BYTEPOS (*it); \ } \ } \ while (0) @@ -19006,7 +19021,8 @@ See also `bidi-paragraph-direction'. */) buf = XBUFFER (buffer); } - if (NILP (BVAR (buf, bidi_display_reordering))) + if (NILP (BVAR (buf, bidi_display_reordering)) + || NILP (BVAR (buf, enable_multibyte_characters))) return Qleft_to_right; else if (!NILP (BVAR (buf, bidi_paragraph_direction))) return BVAR (buf, bidi_paragraph_direction); @@ -24057,6 +24073,8 @@ x_produce_glyphs (struct it *it) Lisp_Object gstring; struct font_metrics metrics; + it->nglyphs = 1; + gstring = composition_gstring_from_id (it->cmp_it.id); it->pixel_width = composition_gstring_width (gstring, it->cmp_it.from, it->cmp_it.to, |