Using saved parent location: http://bzr.savannah.gnu.org/r/emacs/trunk/ Now on revision 104445. ------------------------------------------------------------ revno: 104445 committer: Paul Eggert branch nick: trunk timestamp: Mon 2011-05-30 22:38:59 -0700 message: * ccl.c: Improve comment. (Bug#8751) diff: === modified file 'src/ccl.c' --- src/ccl.c 2011-05-31 02:12:01 +0000 +++ src/ccl.c 2011-05-31 05:38:59 +0000 @@ -93,9 +93,8 @@ |------------- constant or other args ----------------| cccccccccccccccccccccccccccc - where `cc...c' is an integer indicating a constant value or an - absolute jump address. The context determines whether `cc...c' is - considered to be unsigned, or a signed two's complement number. `RRR' + where `cc...c' is a 17-bit, 20-bit, or 28-bit integer indicating a + constant value or a relative/absolute jump address, `RRR' and `rrr' are CCL register number, `XXXXX' is one of the following CCL commands. */ ------------------------------------------------------------ revno: 104444 [merge] committer: Paul Eggert branch nick: trunk timestamp: Mon 2011-05-30 22:34:40 -0700 message: Use 'inline', not 'INLINE'. [ChangeLog] * configure.in (INLINE): Remove. [lib-src/ChangeLog] * etags.c (hash): Now inline unconditionally. * make-docfile.c (put_char): inline, not INLINE. [nt/ChangeLog] * config.nt (INLINE): Remove. [src/ChangeLog] * alloc.c, fontset.c (INLINE): Remove. * alloc.c, bidi.c, charset.c, coding.c, dispnew.c, fns.c, image.c: * intervals.c, keyboard.c, process.c, syntax.c, textprop.c, w32term.c: * xdisp.c, xfaces.c, xterm.c: Replace all uses of INLINE with inline. * gmalloc.c (register_heapinfo): Use inline unconditionally. * lisp.h (LISP_MAKE_RVALUE): Use inline, not __inline__. diff: === modified file 'ChangeLog' --- ChangeLog 2011-05-29 21:52:18 +0000 +++ ChangeLog 2011-05-31 05:34:40 +0000 @@ -1,3 +1,8 @@ +2011-05-30 Paul Eggert + + Use 'inline', not 'INLINE'. + * configure.in (INLINE): Remove. + 2011-05-29 Paul Eggert Adjust to recent gnulib change for @GUARD_PREFIX@. === modified file 'configure.in' --- configure.in 2011-05-26 00:55:14 +0000 +++ configure.in 2011-05-28 22:39:39 +0000 @@ -1286,9 +1286,6 @@ AC_C_PROTOTYPES AC_C_VOLATILE AC_C_CONST -dnl This isn't useful because we can't turn on use of `inline' unless -dnl the compiler groks `extern inline'. -dnl AC_C_INLINE AC_CACHE_CHECK([for void * support], emacs_cv_void_star, [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([], [[void * foo;]])], emacs_cv_void_star=yes, emacs_cv_void_star=no)]) @@ -3449,16 +3446,6 @@ /* Turned on June 1996 supposing nobody will mind it. */ #define AMPERSAND_FULL_NAME -/* If using GNU, then support inline function declarations. */ -/* Don't try to switch on inline handling as detected by AC_C_INLINE - generally, because even if non-gcc compilers accept `inline', they - may reject `extern inline'. */ -#if defined (__GNUC__) -#define INLINE __inline__ -#else -#define INLINE -#endif - /* `subprocesses' should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). === modified file 'lib-src/ChangeLog' --- lib-src/ChangeLog 2011-05-25 07:13:57 +0000 +++ lib-src/ChangeLog 2011-05-28 22:39:39 +0000 @@ -1,3 +1,9 @@ +2011-05-28 Paul Eggert + + Use 'inline', not 'INLINE'. + * etags.c (hash): Now inline unconditionally. + * make-docfile.c (put_char): inline, not INLINE. + 2011-05-25 Glenn Morris * Makefile.in (.c.o): Remove (every .o file has an explicit rule). === modified file 'lib-src/etags.c' --- lib-src/etags.c 2011-05-21 02:27:00 +0000 +++ lib-src/etags.c 2011-05-28 22:39:39 +0000 @@ -2360,14 +2360,7 @@ struct C_stab_entry { const char *name; int c_ext; enum sym_type type; }; /* maximum key range = 33, duplicates = 0 */ -#ifdef __GNUC__ -__inline -#else -#ifdef __cplusplus -inline -#endif -#endif -static unsigned int +static inline unsigned int hash (register const char *str, register unsigned int len) { static unsigned char asso_values[] = === modified file 'lib-src/make-docfile.c' --- lib-src/make-docfile.c 2011-04-01 20:28:50 +0000 +++ lib-src/make-docfile.c 2011-05-28 22:39:39 +0000 @@ -291,7 +291,7 @@ /* Output CH to the file or buffer in STATE. Any pending newlines or spaces are output first. */ -static INLINE void +static inline void put_char (int ch, struct rcsoc_state *state) { int out_ch; === modified file 'nt/ChangeLog' --- nt/ChangeLog 2011-05-17 18:17:45 +0000 +++ nt/ChangeLog 2011-05-28 22:39:39 +0000 @@ -1,3 +1,8 @@ +2011-05-28 Paul Eggert + + Use 'inline', not 'INLINE'. + * config.nt (INLINE): Remove. + 2011-05-17 Eli Zaretskii * README.W32: Add information about GnuTLS libraries. === modified file 'nt/config.nt' --- nt/config.nt 2011-05-09 13:35:56 +0000 +++ nt/config.nt 2011-05-28 22:39:39 +0000 @@ -362,14 +362,6 @@ /* End of gnulib-related stuff. */ -/* If using GNU, then support inline function declarations. */ -#ifdef __GNUC__ -#define INLINE __inline__ -#define inline __inline__ -#else -#define INLINE -#endif - #if __GNUC__ >= 3 /* On GCC 3.0 we might get a warning. */ #define NO_INLINE __attribute__((noinline)) #else === modified file 'src/ChangeLog' --- src/ChangeLog 2011-05-31 05:12:19 +0000 +++ src/ChangeLog 2011-05-31 05:24:53 +0000 @@ -1,3 +1,14 @@ +2011-05-31 Paul Eggert + + Use 'inline', not 'INLINE'. + + * alloc.c, fontset.c (INLINE): Remove. + * alloc.c, bidi.c, charset.c, coding.c, dispnew.c, fns.c, image.c: + * intervals.c, keyboard.c, process.c, syntax.c, textprop.c, w32term.c: + * xdisp.c, xfaces.c, xterm.c: Replace all uses of INLINE with inline. + * gmalloc.c (register_heapinfo): Use inline unconditionally. + * lisp.h (LISP_MAKE_RVALUE): Use inline, not __inline__. + 2011-05-31 Dan Nicolaescu Make it possible to run ./temacs. === modified file 'src/alloc.c' --- src/alloc.c 2011-05-30 16:09:29 +0000 +++ src/alloc.c 2011-05-31 05:15:34 +0000 @@ -22,10 +22,6 @@ #include /* For CHAR_BIT. */ #include -#ifdef ALLOC_DEBUG -#undef INLINE -#endif - #include #ifdef HAVE_GTK_AND_PTHREAD @@ -408,7 +404,7 @@ static void mem_rotate_right (struct mem_node *); static void mem_delete (struct mem_node *); static void mem_delete_fixup (struct mem_node *); -static INLINE struct mem_node *mem_find (void *); +static inline struct mem_node *mem_find (void *); #if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS @@ -3374,7 +3370,7 @@ /* Value is a pointer to the mem_node containing START. Value is MEM_NIL if there is no node in the tree containing START. */ -static INLINE struct mem_node * +static inline struct mem_node * mem_find (void *start) { struct mem_node *p; @@ -3750,7 +3746,7 @@ /* Value is non-zero if P is a pointer to a live Lisp string on the heap. M is a pointer to the mem_block for P. */ -static INLINE int +static inline int live_string_p (struct mem_node *m, void *p) { if (m->type == MEM_TYPE_STRING) @@ -3773,7 +3769,7 @@ /* Value is non-zero if P is a pointer to a live Lisp cons on the heap. M is a pointer to the mem_block for P. */ -static INLINE int +static inline int live_cons_p (struct mem_node *m, void *p) { if (m->type == MEM_TYPE_CONS) @@ -3799,7 +3795,7 @@ /* Value is non-zero if P is a pointer to a live Lisp symbol on the heap. M is a pointer to the mem_block for P. */ -static INLINE int +static inline int live_symbol_p (struct mem_node *m, void *p) { if (m->type == MEM_TYPE_SYMBOL) @@ -3825,7 +3821,7 @@ /* Value is non-zero if P is a pointer to a live Lisp float on the heap. M is a pointer to the mem_block for P. */ -static INLINE int +static inline int live_float_p (struct mem_node *m, void *p) { if (m->type == MEM_TYPE_FLOAT) @@ -3849,7 +3845,7 @@ /* Value is non-zero if P is a pointer to a live Lisp Misc on the heap. M is a pointer to the mem_block for P. */ -static INLINE int +static inline int live_misc_p (struct mem_node *m, void *p) { if (m->type == MEM_TYPE_MISC) @@ -3875,7 +3871,7 @@ /* Value is non-zero if P is a pointer to a live vector-like object. M is a pointer to the mem_block for P. */ -static INLINE int +static inline int live_vector_p (struct mem_node *m, void *p) { return (p == m->start && m->type == MEM_TYPE_VECTORLIKE); @@ -3885,7 +3881,7 @@ /* Value is non-zero if P is a pointer to a live buffer. M is a pointer to the mem_block for P. */ -static INLINE int +static inline int live_buffer_p (struct mem_node *m, void *p) { /* P must point to the start of the block, and the buffer @@ -3951,7 +3947,7 @@ /* Mark OBJ if we can prove it's a Lisp_Object. */ -static INLINE void +static inline void mark_maybe_object (Lisp_Object obj) { void *po; @@ -4020,7 +4016,7 @@ /* If P points to Lisp data, mark that as live if it isn't already marked. */ -static INLINE void +static inline void mark_maybe_pointer (void *p) { struct mem_node *m; === modified file 'src/bidi.c' --- src/bidi.c 2011-04-19 00:34:42 +0000 +++ src/bidi.c 2011-05-28 22:39:39 +0000 @@ -137,7 +137,7 @@ /* Return the bidi type of a character CH, subject to the current directional OVERRIDE. */ -static INLINE bidi_type_t +static inline bidi_type_t bidi_get_type (int ch, bidi_dir_t override) { bidi_type_t default_type; @@ -188,7 +188,7 @@ } /* Given a bidi TYPE of a character, return its category. */ -static INLINE bidi_category_t +static inline bidi_category_t bidi_get_category (bidi_type_t type) { switch (type) @@ -252,7 +252,7 @@ /* Copy the bidi iterator from FROM to TO. To save cycles, this only copies the part of the level stack that is actually in use. */ -static INLINE void +static inline void bidi_copy_it (struct bidi_it *to, struct bidi_it *from) { int i; @@ -275,14 +275,14 @@ static int bidi_cache_idx; /* next unused cache slot */ static int bidi_cache_last_idx; /* slot of last cache hit */ -static INLINE void +static inline void bidi_cache_reset (void) { bidi_cache_idx = 0; bidi_cache_last_idx = -1; } -static INLINE void +static inline void bidi_cache_shrink (void) { if (bidi_cache_size > BIDI_CACHE_CHUNK) @@ -294,7 +294,7 @@ bidi_cache_reset (); } -static INLINE void +static inline void bidi_cache_fetch_state (int idx, struct bidi_it *bidi_it) { int current_scan_dir = bidi_it->scan_dir; @@ -311,7 +311,7 @@ level less or equal to LEVEL. if LEVEL is -1, disregard the resolved levels in cached states. DIR, if non-zero, means search in that direction from the last cache hit. */ -static INLINE int +static inline int bidi_cache_search (EMACS_INT charpos, int level, int dir) { int i, i_start; @@ -402,7 +402,7 @@ return -1; } -static INLINE void +static inline void bidi_cache_iterator_state (struct bidi_it *bidi_it, int resolved) { int idx; @@ -460,7 +460,7 @@ bidi_cache_idx = idx + 1; } -static INLINE bidi_type_t +static inline bidi_type_t bidi_cache_find (EMACS_INT charpos, int level, struct bidi_it *bidi_it) { int i = bidi_cache_search (charpos, level, bidi_it->scan_dir); @@ -480,7 +480,7 @@ return UNKNOWN_BT; } -static INLINE int +static inline int bidi_peek_at_next_level (struct bidi_it *bidi_it) { if (bidi_cache_idx == 0 || bidi_cache_last_idx == -1) @@ -519,7 +519,7 @@ embedding levels on either side of the run boundary. Also, update the saved info about previously seen characters, since that info is generally valid for a single level run. */ -static INLINE void +static inline void bidi_set_sor_type (struct bidi_it *bidi_it, int level_before, int level_after) { int higher_level = level_before > level_after ? level_before : level_after; @@ -729,7 +729,7 @@ /* Do whatever UAX#9 clause X8 says should be done at paragraph's end. */ -static INLINE void +static inline void bidi_set_paragraph_end (struct bidi_it *bidi_it) { bidi_it->invalid_levels = 0; @@ -772,7 +772,7 @@ /* Push the current embedding level and override status; reset the current level to LEVEL and the current override status to OVERRIDE. */ -static INLINE void +static inline void bidi_push_embedding_level (struct bidi_it *bidi_it, int level, bidi_dir_t override) { @@ -785,7 +785,7 @@ /* Pop the embedding level and directional override status from the stack, and return the new level. */ -static INLINE int +static inline int bidi_pop_embedding_level (struct bidi_it *bidi_it) { /* UAX#9 says to ignore invalid PDFs. */ @@ -795,7 +795,7 @@ } /* Record in SAVED_INFO the information about the current character. */ -static INLINE void +static inline void bidi_remember_char (struct bidi_saved_info *saved_info, struct bidi_it *bidi_it) { @@ -811,7 +811,7 @@ /* Resolve the type of a neutral character according to the type of surrounding strong text and the current embedding level. */ -static INLINE bidi_type_t +static inline bidi_type_t bidi_resolve_neutral_1 (bidi_type_t prev_type, bidi_type_t next_type, int lev) { /* N1: European and Arabic numbers are treated as though they were R. */ @@ -828,7 +828,7 @@ return STRONG_R; } -static INLINE int +static inline int bidi_explicit_dir_char (int c) { /* FIXME: this should be replaced with a lookup table with suitable === modified file 'src/charset.c' --- src/charset.c 2011-05-01 16:27:34 +0000 +++ src/charset.c 2011-05-28 22:39:39 +0000 @@ -418,7 +418,7 @@ /* Read a hexadecimal number (preceded by "0x") from the file FP while paying attention to comment character '#'. */ -static INLINE unsigned +static inline unsigned read_hex (FILE *fp, int *eof) { int c; === modified file 'src/coding.c' --- src/coding.c 2011-05-29 21:09:52 +0000 +++ src/coding.c 2011-05-30 01:12:12 +0000 @@ -864,21 +864,21 @@ static Lisp_Object get_translation_table (Lisp_Object, int, int *); static Lisp_Object get_translation (Lisp_Object, int *, int *); static int produce_chars (struct coding_system *, Lisp_Object, int); -static INLINE void produce_charset (struct coding_system *, int *, +static inline void produce_charset (struct coding_system *, int *, EMACS_INT); static void produce_annotation (struct coding_system *, EMACS_INT); static int decode_coding (struct coding_system *); -static INLINE int *handle_composition_annotation (EMACS_INT, EMACS_INT, +static inline int *handle_composition_annotation (EMACS_INT, EMACS_INT, struct coding_system *, int *, EMACS_INT *); -static INLINE int *handle_charset_annotation (EMACS_INT, EMACS_INT, +static inline int *handle_charset_annotation (EMACS_INT, EMACS_INT, struct coding_system *, int *, EMACS_INT *); static void consume_chars (struct coding_system *, Lisp_Object, int); static int encode_coding (struct coding_system *); static Lisp_Object make_conversion_work_buffer (int); static Lisp_Object code_conversion_restore (Lisp_Object); -static INLINE int char_encodable_p (int, Lisp_Object); +static inline int char_encodable_p (int, Lisp_Object); static Lisp_Object make_subsidiaries (Lisp_Object); static void @@ -6829,7 +6829,7 @@ [ -LENGTH ANNOTATION_MASK NCHARS NBYTES METHOD [ COMPONENTS... ] ] */ -static INLINE void +static inline void produce_composition (struct coding_system *coding, int *charbuf, EMACS_INT pos) { int len; @@ -6873,7 +6873,7 @@ [ -LENGTH ANNOTATION_MASK NCHARS CHARSET-ID ] */ -static INLINE void +static inline void produce_charset (struct coding_system *coding, int *charbuf, EMACS_INT pos) { EMACS_INT from = pos - charbuf[2]; @@ -7101,7 +7101,7 @@ position of a composition after POS (if any) or to LIMIT, and return BUF. */ -static INLINE int * +static inline int * handle_composition_annotation (EMACS_INT pos, EMACS_INT limit, struct coding_system *coding, int *buf, EMACS_INT *stop) @@ -7184,7 +7184,7 @@ If the property value is nil, set *STOP to the position where the property value is non-nil (limiting by LIMIT), and return BUF. */ -static INLINE int * +static inline int * handle_charset_annotation (EMACS_INT pos, EMACS_INT limit, struct coding_system *coding, int *buf, EMACS_INT *stop) @@ -8435,7 +8435,7 @@ } -static INLINE int +static inline int char_encodable_p (int c, Lisp_Object attrs) { Lisp_Object tail; === modified file 'src/dispnew.c' --- src/dispnew.c 2011-05-25 03:45:04 +0000 +++ src/dispnew.c 2011-05-28 22:39:39 +0000 @@ -1101,7 +1101,7 @@ /* Exchange pointers to glyph memory between glyph rows A and B. */ -static INLINE void +static inline void swap_glyph_pointers (struct glyph_row *a, struct glyph_row *b) { int i; @@ -1117,7 +1117,7 @@ /* Copy glyph row structure FROM to glyph row structure TO, except that glyph pointers in the structures are left unchanged. */ -static INLINE void +static inline void copy_row_except_pointers (struct glyph_row *to, struct glyph_row *from) { struct glyph *pointers[1 + LAST_AREA]; @@ -1138,7 +1138,7 @@ exchanged between TO and FROM. Pointers must be exchanged to avoid a memory leak. */ -static INLINE void +static inline void assign_row (struct glyph_row *to, struct glyph_row *from) { swap_glyph_pointers (to, from); @@ -1304,7 +1304,7 @@ and B have equal contents. MOUSE_FACE_P non-zero means compare the mouse_face_p flags of A and B, too. */ -static INLINE int +static inline int row_equal_p (struct glyph_row *a, struct glyph_row *b, int mouse_face_p) { if (a == b) @@ -2729,7 +2729,7 @@ function must be called before updates to make explicit that we are working on frame matrices or not. */ -static INLINE void +static inline void set_frame_matrix_frame (struct frame *f) { frame_matrix_frame = f; @@ -2744,7 +2744,7 @@ done in frame matrices, and that we have to perform analogous operations in window matrices of frame_matrix_frame. */ -static INLINE void +static inline void make_current (struct glyph_matrix *desired_matrix, struct glyph_matrix *current_matrix, int row) { struct glyph_row *current_row = MATRIX_ROW (current_matrix, row); @@ -4246,7 +4246,7 @@ /* Add glyph row ROW to the scrolling hash table. */ -static INLINE struct row_entry * +static inline struct row_entry * add_row_entry (struct glyph_row *row) { struct row_entry *entry; === modified file 'src/fns.c' --- src/fns.c 2011-05-28 12:19:08 +0000 +++ src/fns.c 2011-05-28 22:39:39 +0000 @@ -3704,7 +3704,7 @@ /* Resize hash table H if it's too full. If H cannot be resized because it's already too large, throw an error. */ -static INLINE void +static inline void maybe_resize_hash_table (struct Lisp_Hash_Table *h) { if (NILP (h->next_free)) === modified file 'src/fontset.c' --- src/fontset.c 2011-04-14 05:04:02 +0000 +++ src/fontset.c 2011-05-28 22:39:39 +0000 @@ -58,8 +58,6 @@ #undef xassert #ifdef FONTSET_DEBUG #define xassert(X) do {if (!(X)) abort ();} while (0) -#undef INLINE -#define INLINE #else /* not FONTSET_DEBUG */ #define xassert(X) (void) 0 #endif /* not FONTSET_DEBUG */ === modified file 'src/gmalloc.c' --- src/gmalloc.c 2011-01-17 19:01:01 +0000 +++ src/gmalloc.c 2011-05-28 22:39:39 +0000 @@ -552,12 +552,8 @@ /* This is called when `_heapinfo' and `heapsize' have just been set to describe a new info table. Set up the table to describe itself and account for it in the statistics. */ -static void register_heapinfo PP ((void)); -#ifdef __GNUC__ -__inline__ -#endif -static void -register_heapinfo () +static inline void +register_heapinfo (void) { __malloc_size_t block, blocks; @@ -2170,4 +2166,3 @@ } #endif /* GC_MCHECK */ - === modified file 'src/image.c' --- src/image.c 2011-05-29 18:17:28 +0000 +++ src/image.c 2011-05-30 01:12:12 +0000 @@ -623,7 +623,7 @@ /* Look up image type SYMBOL, and return a pointer to its image_type structure. Value is null if SYMBOL is not a known image type. */ -static INLINE struct image_type * +static inline struct image_type * lookup_image_type (Lisp_Object symbol) { struct image_type *type; === modified file 'src/intervals.c' --- src/intervals.c 2011-04-20 08:30:52 +0000 +++ src/intervals.c 2011-05-28 22:39:39 +0000 @@ -313,7 +313,7 @@ c c */ -static INLINE INTERVAL +static inline INTERVAL rotate_right (INTERVAL interval) { INTERVAL i; @@ -360,7 +360,7 @@ c c */ -static INLINE INTERVAL +static inline INTERVAL rotate_left (INTERVAL interval) { INTERVAL i; @@ -438,7 +438,7 @@ /* Balance INTERVAL, potentially stuffing it back into its parent Lisp Object. */ -static INLINE INTERVAL +static inline INTERVAL balance_possible_root_interval (register INTERVAL interval) { Lisp_Object parent; @@ -1427,7 +1427,7 @@ at position START. Addition or deletion is indicated by the sign of LENGTH. */ -INLINE void +inline void offset_intervals (struct buffer *buffer, EMACS_INT start, EMACS_INT length) { if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) || length == 0) @@ -1883,7 +1883,7 @@ /* Set point in BUFFER "temporarily" to CHARPOS, which corresponds to byte position BYTEPOS. */ -INLINE void +inline void temp_set_point_both (struct buffer *buffer, EMACS_INT charpos, EMACS_INT bytepos) { @@ -1903,7 +1903,7 @@ /* Set point "temporarily", without checking any text properties. */ -INLINE void +inline void temp_set_point (struct buffer *buffer, EMACS_INT charpos) { temp_set_point_both (buffer, charpos, @@ -2392,7 +2392,7 @@ /* Give STRING the properties of BUFFER from POSITION to LENGTH. */ -INLINE void +inline void copy_intervals_to_string (Lisp_Object string, struct buffer *buffer, EMACS_INT position, EMACS_INT length) { === modified file 'src/keyboard.c' --- src/keyboard.c 2011-05-15 17:17:44 +0000 +++ src/keyboard.c 2011-05-28 22:39:39 +0000 @@ -3742,7 +3742,7 @@ /* Clear input event EVENT. */ -static INLINE void +static inline void clear_event (struct input_event *event) { event->kind = NO_EVENT; === modified file 'src/lisp.h' --- src/lisp.h 2011-05-30 05:39:59 +0000 +++ src/lisp.h 2011-05-31 05:15:34 +0000 @@ -317,7 +317,7 @@ #endif /* WORDS_BIGENDIAN */ #ifdef __GNUC__ -static __inline__ Lisp_Object +static inline Lisp_Object LISP_MAKE_RVALUE (Lisp_Object o) { return o; === modified file 'src/process.c' --- src/process.c 2011-05-12 07:07:06 +0000 +++ src/process.c 2011-05-28 22:39:39 +0000 @@ -4162,7 +4162,7 @@ impossible to step through wait_reading_process_output. */ #ifndef select -static INLINE int +static inline int select_wrapper (int n, fd_set *rfd, fd_set *wfd, fd_set *xfd, struct timeval *tmo) { return select (n, rfd, wfd, xfd, tmo); === modified file 'src/syntax.c' --- src/syntax.c 2011-05-12 07:07:06 +0000 +++ src/syntax.c 2011-05-28 22:39:39 +0000 @@ -367,7 +367,7 @@ /* Return the bytepos one character before BYTEPOS. We assume that BYTEPOS is not at the start of the buffer. */ -static INLINE EMACS_INT +static inline EMACS_INT dec_bytepos (EMACS_INT bytepos) { if (NILP (BVAR (current_buffer, enable_multibyte_characters))) === modified file 'src/textprop.c' --- src/textprop.c 2011-05-12 07:07:06 +0000 +++ src/textprop.c 2011-05-28 22:39:39 +0000 @@ -248,7 +248,7 @@ /* Return nonzero if the plist of interval I has any of the properties of PLIST, regardless of their values. */ -static INLINE int +static inline int interval_has_some_properties (Lisp_Object plist, INTERVAL i) { register Lisp_Object tail1, tail2, sym; @@ -270,7 +270,7 @@ /* Return nonzero if the plist of interval I has any of the property names in LIST, regardless of their values. */ -static INLINE int +static inline int interval_has_some_properties_list (Lisp_Object list, INTERVAL i) { register Lisp_Object tail1, tail2, sym; @@ -499,7 +499,7 @@ /* Remove all properties from interval I. Return non-zero if this changes the interval. */ -static INLINE int +static inline int erase_properties (INTERVAL i) { if (NILP (i->plist)) === modified file 'src/w32term.c' --- src/w32term.c 2011-05-12 07:07:06 +0000 +++ src/w32term.c 2011-05-28 22:39:39 +0000 @@ -1002,7 +1002,7 @@ Faces to use in the mode line have already been computed when the matrix was built, so there isn't much to do, here. */ -static INLINE void +static inline void x_set_mode_line_face_gc (struct glyph_string *s) { s->gc = s->face->gc; @@ -1013,7 +1013,7 @@ S->stippled_p to a non-zero value if the face of S has a stipple pattern. */ -static INLINE void +static inline void x_set_glyph_string_gc (struct glyph_string *s) { PREPARE_FACE_FOR_DISPLAY (s->f, s->face); @@ -1058,7 +1058,7 @@ /* Set clipping for output of glyph string S. S may be part of a mode line or menu if we don't have X toolkit support. */ -static INLINE void +static inline void x_set_glyph_string_clipping (struct glyph_string *s) { RECT *r = s->clip; @@ -1128,7 +1128,7 @@ /* Fill rectangle X, Y, W, H with background color of glyph string S. */ -static INLINE void +static inline void x_clear_glyph_string_rect (struct glyph_string *s, int x, int y, int w, int h) { === modified file 'src/xdisp.c' --- src/xdisp.c 2011-05-25 03:45:04 +0000 +++ src/xdisp.c 2011-05-28 22:39:39 +0000 @@ -926,7 +926,7 @@ This is the height of W minus the height of a mode line, if any. */ -INLINE int +inline int window_text_bottom_y (struct window *w) { int height = WINDOW_TOTAL_HEIGHT (w); @@ -940,7 +940,7 @@ means return the total width of W, not including fringes to the left and right of the window. */ -INLINE int +inline int window_box_width (struct window *w, int area) { int cols = XFASTINT (w->total_cols); @@ -979,7 +979,7 @@ /* Return the pixel height of the display area of window W, not including mode lines of W, if any. */ -INLINE int +inline int window_box_height (struct window *w) { struct frame *f = XFRAME (w->frame); @@ -1026,7 +1026,7 @@ area AREA of window W. AREA < 0 means return the left edge of the whole window, to the right of the left fringe of W. */ -INLINE int +inline int window_box_left_offset (struct window *w, int area) { int x; @@ -1058,7 +1058,7 @@ area AREA of window W. AREA < 0 means return the right edge of the whole window, to the left of the right fringe of W. */ -INLINE int +inline int window_box_right_offset (struct window *w, int area) { return window_box_left_offset (w, area) + window_box_width (w, area); @@ -1068,7 +1068,7 @@ area AREA of window W. AREA < 0 means return the left edge of the whole window, to the right of the left fringe of W. */ -INLINE int +inline int window_box_left (struct window *w, int area) { struct frame *f = XFRAME (w->frame); @@ -1088,7 +1088,7 @@ area AREA of window W. AREA < 0 means return the right edge of the whole window, to the left of the right fringe of W. */ -INLINE int +inline int window_box_right (struct window *w, int area) { return window_box_left (w, area) + window_box_width (w, area); @@ -1101,7 +1101,7 @@ coordinates of the upper-left corner of the box. Return in *BOX_WIDTH, and *BOX_HEIGHT the pixel width and height of the box. */ -INLINE void +inline void window_box (struct window *w, int area, int *box_x, int *box_y, int *box_width, int *box_height) { @@ -1128,7 +1128,7 @@ *BOTTOM_RIGHT_Y the coordinates of the bottom-right corner of the box. */ -static INLINE void +static inline void window_box_edges (struct window *w, int area, int *top_left_x, int *top_left_y, int *bottom_right_x, int *bottom_right_y) { @@ -1328,7 +1328,7 @@ returns an invalid character. If we find one, we return a `?', but with the length of the invalid character. */ -static INLINE int +static inline int string_char_and_length (const unsigned char *str, int *len) { int c; @@ -1376,7 +1376,7 @@ /* Value is the text position, i.e. character and byte position, for character position CHARPOS in STRING. */ -static INLINE struct text_pos +static inline struct text_pos string_pos (EMACS_INT charpos, Lisp_Object string) { struct text_pos pos; @@ -11061,7 +11061,7 @@ buffer position, END is given as a distance from Z. Used in redisplay_internal for display optimization. */ -static INLINE int +static inline int text_outside_line_unchanged_p (struct window *w, EMACS_INT start, EMACS_INT end) { @@ -11322,7 +11322,7 @@ /* Reconsider the setting of B->clip_changed which is displayed in window W. */ -static INLINE void +static inline void reconsider_clip_changes (struct window *w, struct buffer *b) { if (b->clip_changed @@ -12883,7 +12883,7 @@ We assume that the window's buffer is really current. */ -static INLINE struct text_pos +static inline struct text_pos run_window_scroll_functions (Lisp_Object window, struct text_pos startp) { struct window *w = XWINDOW (window); @@ -20417,7 +20417,7 @@ /* Append the list of glyph strings with head H and tail T to the list with head *HEAD and tail *TAIL. Set *HEAD and *TAIL to the result. */ -static INLINE void +static inline void append_glyph_string_lists (struct glyph_string **head, struct glyph_string **tail, struct glyph_string *h, struct glyph_string *t) { @@ -20437,7 +20437,7 @@ list with head *HEAD and tail *TAIL. Set *HEAD and *TAIL to the result. */ -static INLINE void +static inline void prepend_glyph_string_lists (struct glyph_string **head, struct glyph_string **tail, struct glyph_string *h, struct glyph_string *t) { @@ -20456,7 +20456,7 @@ /* Append glyph string S to the list with head *HEAD and tail *TAIL. Set *HEAD and *TAIL to the resulting list. */ -static INLINE void +static inline void append_glyph_string (struct glyph_string **head, struct glyph_string **tail, struct glyph_string *s) { @@ -20471,7 +20471,7 @@ Value is a pointer to a realized face that is ready for display if DISPLAY_P is non-zero. */ -static INLINE struct face * +static inline struct face * get_char_face_and_encoding (struct frame *f, int c, int face_id, XChar2b *char2b, int display_p) { @@ -20504,7 +20504,7 @@ The encoding of GLYPH->u.ch is returned in *CHAR2B. Value is a pointer to a realized face that is ready for display. */ -static INLINE struct face * +static inline struct face * get_glyph_face_and_encoding (struct frame *f, struct glyph *glyph, XChar2b *char2b, int *two_byte_p) { @@ -20541,7 +20541,7 @@ /* Get glyph code of character C in FONT in the two-byte form CHAR2B. Retunr 1 if FONT has a glyph for C, otherwise return 0. */ -static INLINE int +static inline int get_char_glyph_code (int c, struct font *font, XChar2b *char2b) { unsigned code; @@ -21005,7 +21005,7 @@ first glyph following S. LAST_X is the right-most x-position + 1 in the drawing area. */ -static INLINE void +static inline void set_glyph_string_background_width (struct glyph_string *s, int start, int last_x) { /* If the face of this glyph string has to be drawn to the end of @@ -21567,7 +21567,7 @@ /* Store one glyph for IT->char_to_display in IT->glyph_row. Called from x_produce_glyphs when IT->glyph_row is non-null. */ -static INLINE void +static inline void append_glyph (struct it *it) { struct glyph *glyph; @@ -21641,7 +21641,7 @@ IT->glyph_row. Called from x_produce_glyphs when IT->glyph_row is non-null. */ -static INLINE void +static inline void append_composite_glyph (struct it *it) { struct glyph *glyph; @@ -21710,7 +21710,7 @@ /* Change IT->ascent and IT->height according to the setting of IT->voffset. */ -static INLINE void +static inline void take_vertical_position_into_account (struct it *it) { if (it->voffset) === modified file 'src/xfaces.c' --- src/xfaces.c 2011-05-12 07:07:06 +0000 +++ src/xfaces.c 2011-05-28 22:39:39 +0000 @@ -646,7 +646,7 @@ /* Create and return a GC for use on frame F. GC values and mask are given by XGCV and MASK. */ -static INLINE GC +static inline GC x_create_gc (struct frame *f, long unsigned int mask, XGCValues *xgcv) { GC gc; @@ -660,7 +660,7 @@ /* Free GC which was used on frame F. */ -static INLINE void +static inline void x_free_gc (struct frame *f, GC gc) { eassert (interrupt_input_blocked); @@ -673,7 +673,7 @@ #ifdef WINDOWSNT /* W32 emulation of GCs */ -static INLINE GC +static inline GC x_create_gc (struct frame *f, unsigned long mask, XGCValues *xgcv) { GC gc; @@ -687,7 +687,7 @@ /* Free GC which was used on frame F. */ -static INLINE void +static inline void x_free_gc (struct frame *f, GC gc) { IF_DEBUG (xassert (--ngcs >= 0)); @@ -699,7 +699,7 @@ #ifdef HAVE_NS /* NS emulation of GCs */ -static INLINE GC +static inline GC x_create_gc (struct frame *f, unsigned long mask, XGCValues *xgcv) @@ -710,7 +710,7 @@ return gc; } -static INLINE void +static inline void x_free_gc (struct frame *f, GC gc) { xfree (gc); @@ -746,7 +746,7 @@ CHECK_LIVE_FRAME. This is here because it's a frequent pattern in Lisp function definitions. */ -static INLINE struct frame * +static inline struct frame * frame_or_selected_frame (Lisp_Object frame, int nparam) { if (NILP (frame)) @@ -1976,7 +1976,7 @@ FACE_NAME and NAMED_MERGE_POINT_KIND, as the head of the linked list pointed to by NAMED_MERGE_POINTS, and return 1. */ -static INLINE int +static inline int push_named_merge_point (struct named_merge_point *new_named_merge_point, Lisp_Object face_name, enum named_merge_point_kind named_merge_point_kind, @@ -2078,7 +2078,7 @@ face text properties; Ediff uses that). If SIGNAL_P is non-zero, signal an error if FACE_NAME is not a valid face name. If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face name. */ -static INLINE Lisp_Object +static inline Lisp_Object lface_from_face_name_no_resolve (struct frame *f, Lisp_Object face_name, int signal_p) { Lisp_Object lface; @@ -2106,7 +2106,7 @@ non-zero, signal an error if FACE_NAME is not a valid face name. If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face name. */ -static INLINE Lisp_Object +static inline Lisp_Object lface_from_face_name (struct frame *f, Lisp_Object face_name, int signal_p) { face_name = resolve_face_name (face_name, signal_p); @@ -2120,7 +2120,7 @@ is non-zero, signal an error if FACE_NAME does not name a face. Otherwise, value is zero if FACE_NAME is not a face. */ -static INLINE int +static inline int get_lface_attributes_no_remap (struct frame *f, Lisp_Object face_name, Lisp_Object *attrs, int signal_p) { Lisp_Object lface; @@ -2141,7 +2141,7 @@ non-zero, signal an error if FACE_NAME does not name a face. Otherwise, value is zero if FACE_NAME is not a face. */ -static INLINE int +static inline int get_lface_attributes (struct frame *f, Lisp_Object face_name, Lisp_Object *attrs, int signal_p, struct named_merge_point *named_merge_points) { Lisp_Object face_remapping; @@ -2307,7 +2307,7 @@ loops in face inheritance/remapping; it should be 0 when called from other places. */ -static INLINE void +static inline void merge_face_vectors (struct frame *f, Lisp_Object *from, Lisp_Object *to, struct named_merge_point *named_merge_points) { int i; @@ -3903,7 +3903,7 @@ all attributes are `equal'. Tries to be fast because this function is called quite often. */ -static INLINE int +static inline int face_attr_equal_p (Lisp_Object v1, Lisp_Object v2) { /* Type can differ, e.g. when one attribute is unspecified, i.e. nil, @@ -3936,7 +3936,7 @@ all attributes are `equal'. Tries to be fast because this function is called quite often. */ -static INLINE int +static inline int lface_equal_p (Lisp_Object *v1, Lisp_Object *v2) { int i, equal_p = 1; @@ -4021,7 +4021,7 @@ /* Return a hash code for Lisp string STRING with case ignored. Used below in computing a hash value for a Lisp face. */ -static INLINE unsigned +static inline unsigned hash_string_case_insensitive (Lisp_Object string) { const unsigned char *s; @@ -4035,7 +4035,7 @@ /* Return a hash code for face attribute vector V. */ -static INLINE unsigned +static inline unsigned lface_hash (Lisp_Object *v) { return (hash_string_case_insensitive (v[LFACE_FAMILY_INDEX]) @@ -4054,7 +4054,7 @@ family, point size, weight, width, slant, and font. Both LFACE1 and LFACE2 must be fully-specified. */ -static INLINE int +static inline int lface_same_font_attributes_p (Lisp_Object *lface1, Lisp_Object *lface2) { xassert (lface_fully_specified_p (lface1) @@ -4460,7 +4460,7 @@ Value is the ID of the face found. If no suitable face is found, realize a new one. */ -static INLINE int +static inline int lookup_face (struct frame *f, Lisp_Object *attr) { struct face_cache *cache = FRAME_FACE_CACHE (f); === modified file 'src/xterm.c' --- src/xterm.c 2011-05-27 16:17:59 +0000 +++ src/xterm.c 2011-05-28 22:39:39 +0000 @@ -1010,7 +1010,7 @@ Faces to use in the mode line have already been computed when the matrix was built, so there isn't much to do, here. */ -static INLINE void +static inline void x_set_mode_line_face_gc (struct glyph_string *s) { s->gc = s->face->gc; @@ -1021,7 +1021,7 @@ S->stippled_p to a non-zero value if the face of S has a stipple pattern. */ -static INLINE void +static inline void x_set_glyph_string_gc (struct glyph_string *s) { PREPARE_FACE_FOR_DISPLAY (s->f, s->face); @@ -1066,7 +1066,7 @@ /* Set clipping for output of glyph string S. S may be part of a mode line or menu if we don't have X toolkit support. */ -static INLINE void +static inline void x_set_glyph_string_clipping (struct glyph_string *s) { XRectangle *r = s->clip; @@ -1139,7 +1139,7 @@ /* Fill rectangle X, Y, W, H with background color of glyph string S. */ -static INLINE void +static inline void x_clear_glyph_string_rect (struct glyph_string *s, int x, int y, int w, int h) { XGCValues xgcv; ------------------------------------------------------------ revno: 104443 committer: Dan Nicolaescu branch nick: trunk timestamp: Mon 2011-05-30 22:12:19 -0700 message: Make it possible to run ./temacs. * callproc.c (set_initial_environment): Remove CANNOT_DUMP code, syms_of_callproc does the same thing. Remove test for "initialized", do it in the caller. * emacs.c (main): Avoid calling set_initial_environment when dumping. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-05-31 03:03:38 +0000 +++ src/ChangeLog 2011-05-31 05:12:19 +0000 @@ -1,3 +1,12 @@ +2011-05-31 Dan Nicolaescu + + Make it possible to run ./temacs. + + * callproc.c (set_initial_environment): Remove CANNOT_DUMP code, + syms_of_callproc does the same thing. Remove test for + "initialized", do it in the caller. + * emacs.c (main): Avoid calling set_initial_environment when dumping. + 2011-05-31 Stefan Monnier * minibuf.c (Finternal_complete_buffer): Return `category' metadata. === modified file 'src/callproc.c' --- src/callproc.c 2011-05-20 09:47:59 +0000 +++ src/callproc.c 2011-05-31 05:12:19 +0000 @@ -1603,20 +1603,13 @@ void set_initial_environment (void) { - register char **envp; -#ifdef CANNOT_DUMP - Vprocess_environment = Qnil; -#else - if (initialized) -#endif - { - for (envp = environ; *envp; envp++) - Vprocess_environment = Fcons (build_string (*envp), - Vprocess_environment); - /* Ideally, the `copy' shouldn't be necessary, but it seems it's frequent - to use `delete' and friends on process-environment. */ - Vinitial_environment = Fcopy_sequence (Vprocess_environment); - } + char **envp; + for (envp = environ; *envp; envp++) + Vprocess_environment = Fcons (build_string (*envp), + Vprocess_environment); + /* Ideally, the `copy' shouldn't be necessary, but it seems it's frequent + to use `delete' and friends on process-environment. */ + Vinitial_environment = Fcopy_sequence (Vprocess_environment); } void === modified file 'src/emacs.c' --- src/emacs.c 2011-05-29 04:08:28 +0000 +++ src/emacs.c 2011-05-31 05:12:19 +0000 @@ -1423,8 +1423,11 @@ syms_of_callproc (); /* egetenv is a pretty low-level facility, which may get called in many circumstances; it seems flimsy to put off initializing it - until calling init_callproc. */ - set_initial_environment (); + until calling init_callproc. Do not do it when dumping. */ + if (initialized || ((strcmp (argv[argc-1], "dump") != 0 + && strcmp (argv[argc-1], "bootstrap") != 0))) + set_initial_environment (); + /* AIX crashes are reported in system versions 3.2.3 and 3.2.4 if this is not done. Do it after set_global_environment so that we don't pollute Vglobal_environment. */ ------------------------------------------------------------ revno: 104442 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2011-05-31 00:03:38 -0300 message: * lisp/minibuffer.el: Add metadata method to completion tables. (completion-category-overrides): New defcustom. (completion-metadata, completion--field-metadata) (completion-metadata-get, completion--styles) (completion--cycle-threshold): New functions. (completion-try-completion, completion-all-completions): Add `metadata' argument to choose completion-styles. (completion--do-completion): Use metadata to choose cycling. (completion-all-sorted-completions): Use metadata for sorting. Remove :completion-cycle-penalty which is not needed any more. (completion--try-word-completion): Add `metadata' argument. (minibuffer-completion-help): Check metadata for annotation function and sorting. (completion-file-name-table): Return `category' metadata. (minibuffer-completing-file-name): Make obsolete. * lisp/simple.el (minibuffer-completing-symbol): Make obsolete. * lisp/icomplete.el (icomplete-completions): Pass new `metadata' param to completion-try-completion. * src/minibuf.c (Finternal_complete_buffer): Return `category' metadata. (read_minibuf): Use get_minibuffer. (syms_of_minibuf): Use DEFSYM. (Qmetadata): New var. * src/data.c (Qbuffer): Don't make it static. (syms_of_data): Use DEFSYM. diff: === modified file 'etc/NEWS' --- etc/NEWS 2011-05-29 00:45:00 +0000 +++ etc/NEWS 2011-05-31 03:03:38 +0000 @@ -91,6 +91,10 @@ *** New completion style `substring'. +*** Completion style can be set per-category `completion-category-overrides'. + +*** Completion of buffers now uses substring completion by default. + *** `completing-read' can be customized using the new variable `completing-read-function'. @@ -861,6 +865,14 @@ *** completion-annotate-function is obsolete. +*** New `metadata' method for completion tables. The metadata thus returned +can specify various details of the data returned by `all-completions': +- `category' is the kind of objects returned (e.g., `buffer', `file', ...), + used to select a style in completion-category-overrides. +- `annotation-function' to add annotations in *Completions*. +- `display-sort-function' to specify how to sort entries in *Completions*. +- `cycle-sort-function' to specify how to sort entries when cycling. + ** `glyphless-char-display' can now distinguish between graphical and text terminal display, via a char-table entry that is a cons cell. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-30 17:23:47 +0000 +++ lisp/ChangeLog 2011-05-31 03:03:38 +0000 @@ -1,3 +1,24 @@ +2011-05-31 Stefan Monnier + + * minibuffer.el: Add metadata method to completion tables. + (completion-category-overrides): New defcustom. + (completion-metadata, completion--field-metadata) + (completion-metadata-get, completion--styles) + (completion--cycle-threshold): New functions. + (completion-try-completion, completion-all-completions): + Add `metadata' argument to choose completion-styles. + (completion--do-completion): Use metadata to choose cycling. + (completion-all-sorted-completions): Use metadata for sorting. + Remove :completion-cycle-penalty which is not needed any more. + (completion--try-word-completion): Add `metadata' argument. + (minibuffer-completion-help): Check metadata for annotation function + and sorting. + (completion-file-name-table): Return `category' metadata. + (minibuffer-completing-file-name): Make obsolete. + * simple.el (minibuffer-completing-symbol): Make obsolete. + * icomplete.el (icomplete-completions): Pass new `metadata' param to + completion-try-completion. + 2011-05-30 Stefan Monnier * mail/smtpmail.el (smtpmail-send-data): Add progress reporter. === modified file 'lisp/icomplete.el' --- lisp/icomplete.el 2011-04-10 21:31:14 +0000 +++ lisp/icomplete.el 2011-05-31 03:03:38 +0000 @@ -287,6 +287,7 @@ are exhibited within the square braces.)" (let* ((non-essential t) + (md (completion--field-metadata (field-beginning))) (comps (completion-all-sorted-completions)) (last (if (consp comps) (last comps))) (base-size (cdr last)) @@ -299,11 +300,11 @@ (let* ((most-try (if (and base-size (> base-size 0)) (completion-try-completion - name candidates predicate (length name)) + name candidates predicate (length name) md) ;; If the `comps' are 0-based, the result should be ;; the same with `comps'. (completion-try-completion - name comps nil (length name)))) + name comps nil (length name) md))) (most (if (consp most-try) (car most-try) (if most-try (car comps) ""))) ;; Compare name and most, so we can determine if name is === modified file 'lisp/minibuffer.el' --- lisp/minibuffer.el 2011-05-28 02:10:32 +0000 +++ lisp/minibuffer.el 2011-05-31 03:03:38 +0000 @@ -61,10 +61,7 @@ ;; - for M-x, cycle-sort commands that have no key binding first. ;; - Make things like icomplete-mode or lightning-completion work with ;; completion-in-region-mode. -;; - extend `boundaries' to provide various other meta-data about the -;; output of `all-completions': -;; - preferred sorting order when displayed in *Completions*. -;; - annotations/text-properties to add when displayed in *Completions*. +;; - extend `metadata': ;; - quoting/unquoting (so we can complete files names with envvars ;; and backslashes, and all-completion can list names without ;; quoting backslashes and dollars). @@ -116,6 +113,32 @@ (cons (or (cadr boundaries) 0) (or (cddr boundaries) (length suffix))))) +(defun completion-metadata (string table pred) + "Return the metadata of elements to complete at the end of STRING. +This metadata is an alist. Currently understood keys are: +- `category': the kind of objects returned by `all-completions'. + Used by `completion-category-overrides'. +- `annotation-function': function to add annotations in *Completions*. + Takes one argument (STRING), which is a possible completion and + returns a string to append to STRING. +- `display-sort-function': function to sort entries in *Completions*. + Takes one argument (COMPLETIONS) and should return a new list + of completions. Can operate destructively. +- `cycle-sort-function': function to sort entries when cycling. + Works like `display-sort-function'." + (let ((metadata (if (functionp table) + (funcall table string pred 'metadata)))) + (if (eq (car-safe metadata) 'metadata) + (cdr metadata)))) + +(defun completion--field-metadata (field-start) + (completion-metadata (buffer-substring-no-properties field-start (point)) + minibuffer-completion-table + minibuffer-completion-predicate)) + +(defun completion-metadata-get (metadata prop) + (cdr (assq prop metadata))) + (defun completion--some (fun xs) "Apply FUN to each element of XS in turn. Return the first non-nil returned value. @@ -457,7 +480,34 @@ :group 'minibuffer :version "23.1") -(defun completion-try-completion (string table pred point) +(defcustom completion-category-overrides + '((buffer (styles . (basic substring)))) + "List of overrides for specific categories. +Each override has the shape (CATEGORY . ALIST) where ALIST is +an association list that can specify properties such as: +- `styles': the list of `completion-styles' to use for that category. +- `cycle': the `completion-cycle-threshold' to use for that category." + :type `(alist :key-type (choice (const buffer) + (const file) + symbol) + :value-type + (set + (cons (const style) + (repeat ,@(mapcar (lambda (x) (list 'const (car x))) + completion-styles-alist))) + (cons (const cycle) + (choice (const :tag "No cycling" nil) + (const :tag "Always cycle" t) + (integer :tag "Threshold")))))) + +(defun completion--styles (metadata) + (let* ((cat (completion-metadata-get metadata 'category)) + (over (assq 'styles (cdr (assq cat completion-category-overrides))))) + (if over + (delete-dups (append (cdr over) (copy-sequence completion-styles))) + completion-styles))) + +(defun completion-try-completion (string table pred point metadata) "Try to complete STRING using completion table TABLE. Only the elements of table that satisfy predicate PRED are considered. POINT is the position of point within STRING. @@ -468,9 +518,9 @@ (completion--some (lambda (style) (funcall (nth 1 (assq style completion-styles-alist)) string table pred point)) - completion-styles)) + (completion--styles metadata))) -(defun completion-all-completions (string table pred point) +(defun completion-all-completions (string table pred point metadata) "List the possible completions of STRING in completion table TABLE. Only the elements of table that satisfy predicate PRED are considered. POINT is the position of point within STRING. @@ -481,7 +531,7 @@ (completion--some (lambda (style) (funcall (nth 2 (assq style completion-styles-alist)) string table pred point)) - completion-styles)) + (completion--styles metadata))) (defun minibuffer--bitset (modified completions exact) (logior (if modified 4 0) @@ -532,6 +582,11 @@ (const :tag "Always cycle" t) (integer :tag "Threshold"))) +(defun completion--cycle-threshold (metadata) + (let* ((cat (completion-metadata-get metadata 'category)) + (over (assq 'cycle (cdr (assq cat completion-category-overrides))))) + (if over (cdr over) completion-cycle-threshold))) + (defvar completion-all-sorted-completions nil) (make-variable-buffer-local 'completion-all-sorted-completions) (defvar completion-cycling nil) @@ -566,12 +621,14 @@ (let* ((beg (field-beginning)) (end (field-end)) (string (buffer-substring beg end)) + (md (completion--field-metadata beg)) (comp (funcall (or try-completion-function 'completion-try-completion) string minibuffer-completion-table minibuffer-completion-predicate - (- (point) beg)))) + (- (point) beg) + md))) (cond ((null comp) (minibuffer-hide-completions) @@ -610,16 +667,17 @@ (completion--do-completion try-completion-function expect-exact) ;; It did find a match. Do we match some possibility exactly now? - (let ((exact (test-completion completion + (let* ((exact (test-completion completion minibuffer-completion-table minibuffer-completion-predicate)) + (threshold (completion--cycle-threshold md)) (comps ;; Check to see if we want to do cycling. We do it ;; here, after having performed the normal completion, ;; so as to take advantage of the difference between ;; try-completion and all-completions, for things ;; like completion-ignored-extensions. - (when (and completion-cycle-threshold + (when (and threshold ;; Check that the completion didn't make ;; us jump to a different boundary. (or (not completed) @@ -636,7 +694,7 @@ (not (ignore-errors ;; This signal an (intended) error if comps is too ;; short or if completion-cycle-threshold is t. - (consp (nthcdr completion-cycle-threshold comps))))) + (consp (nthcdr threshold comps))))) ;; Fewer than completion-cycle-threshold remaining ;; completions: let's cycle. (setq completed t exact t) @@ -715,27 +773,25 @@ (or completion-all-sorted-completions (let* ((start (field-beginning)) (end (field-end)) - (all (completion-all-completions (buffer-substring start end) - minibuffer-completion-table - minibuffer-completion-predicate - (- (point) start))) + (string (buffer-substring start end)) + (all (completion-all-completions + string + minibuffer-completion-table + minibuffer-completion-predicate + (- (point) start) + (completion--field-metadata start))) (last (last all)) - (base-size (or (cdr last) 0))) + (base-size (or (cdr last) 0)) + (all-md (completion-metadata (substring string 0 base-size) + minibuffer-completion-table + minibuffer-completion-predicate)) + (sort-fun (completion-metadata-get all-md 'cycle-sort-function))) (when last (setcdr last nil) - ;; Prefer shorter completions. - (setq all (sort all (lambda (c1 c2) - (let ((s1 (get-text-property - 0 :completion-cycle-penalty c1)) - (s2 (get-text-property - 0 :completion-cycle-penalty c2))) - (if (eq s1 s2) - (< (length c1) (length c2)) - (< (or s1 (length c1)) - (or s2 (length c2)))))))) + (setq all (if sort-fun (funcall sort-fun all) + ;; Prefer shorter completions, by default. + (sort all (lambda (c1 c2) (< (length c1) (length c2)))))) ;; Prefer recently used completions. - ;; FIXME: Additional sorting ideas: - ;; - for M-x, prefer commands that have no key binding. (when (minibufferp) (let ((hist (symbol-value minibuffer-history-variable))) (setq all (sort all (lambda (c1 c2) @@ -758,6 +814,7 @@ ;; ~/src/emacs/trunk/ and throws away lisp/minibuffer.el. (let* ((start (field-beginning)) (end (field-end)) + ;; (md (completion--field-metadata start)) (all (completion-all-sorted-completions)) (base (+ start (or (cdr (last all)) 0)))) (cond @@ -861,8 +918,8 @@ nil)) (t nil)))))) -(defun completion--try-word-completion (string table predicate point) - (let ((comp (completion-try-completion string table predicate point))) +(defun completion--try-word-completion (string table predicate point md) + (let ((comp (completion-try-completion string table predicate point md))) (if (not (consp comp)) comp @@ -884,7 +941,7 @@ (while (and exts (not (consp tem))) (setq tem (completion-try-completion (concat before (pop exts) after) - table predicate (1+ point)))) + table predicate (1+ point) md))) (if (consp tem) (setq comp tem)))) ;; Completing a single word is actually more difficult than completing @@ -1219,7 +1276,8 @@ string minibuffer-completion-table minibuffer-completion-predicate - (- (point) (field-beginning))))) + (- (point) (field-beginning)) + (completion--field-metadata start)))) (message nil) (if (or (null completions) (and (not (consp (cdr completions))) @@ -1235,9 +1293,16 @@ (let* ((last (last completions)) (base-size (cdr last)) (prefix (unless (zerop base-size) (substring string 0 base-size))) - (global-af (or (plist-get completion-extra-properties - :annotation-function) - completion-annotate-function)) + ;; FIXME: This function is for the output of all-completions, + ;; not completion-all-completions. Often it's the same, but + ;; not always. + (all-md (completion-metadata (substring string 0 base-size) + minibuffer-completion-table + minibuffer-completion-predicate)) + (afun (or (completion-metadata-get all-md 'annotation-function) + (plist-get completion-extra-properties + :annotation-function) + completion-annotate-function)) ;; If the *Completions* buffer is shown in a new ;; window, mark it as softly-dedicated, so bury-buffer in ;; minibuffer-hide-completions will know whether to @@ -1247,15 +1312,21 @@ ;; Remove the base-size tail because `sort' requires a properly ;; nil-terminated list. (when last (setcdr last nil)) - (setq completions (sort completions 'string-lessp)) (setq completions - (cond - (global-af + ;; FIXME: This function is for the output of all-completions, + ;; not completion-all-completions. Often it's the same, but + ;; not always. + (let ((sort-fun (completion-metadata-get + all-md 'display-sort-function))) + (if sort-fun + (funcall sort-fun completions) + (sort completions 'string-lessp)))) + (when afun + (setq completions (mapcar (lambda (s) - (let ((ann (funcall global-af s))) + (let ((ann (funcall afun s))) (if ann (list s ann) s))) - completions)) - (t completions))) + completions))) (with-current-buffer standard-output (set (make-local-variable 'completion-base-position) @@ -1270,12 +1341,12 @@ (cpred minibuffer-completion-predicate) (cprops completion-extra-properties)) (lambda (start end choice) - (unless - (or (zerop (length prefix)) - (equal prefix - (buffer-substring-no-properties - (max (point-min) (- start (length prefix))) - start))) + (unless (or (zerop (length prefix)) + (equal prefix + (buffer-substring-no-properties + (max (point-min) + (- start (length prefix))) + start))) (message "*Completions* out of date")) ;; FIXME: Use `md' to do quoting&terminator here. (completion--replace start end choice) @@ -1632,6 +1703,7 @@ "Completion table for file names." (ignore-errors (cond + ((eq action 'metadata) '(metadata (category . file))) ((eq (car-safe action) 'boundaries) (let ((start (length (file-name-directory string))) (end (string-match-p "/" (cdr action)))) @@ -1852,6 +1924,11 @@ (funcall (or read-file-name-function #'read-file-name-default) prompt dir default-filename mustmatch initial predicate)) +;; minibuffer-completing-file-name is a variable used internally in minibuf.c +;; to determine whether to use minibuffer-local-filename-completion-map or +;; minibuffer-local-completion-map. It shouldn't be exported to Elisp. +(make-obsolete-variable 'minibuffer-completing-file-name nil "24.1") + (defun read-file-name-default (prompt &optional dir default-filename mustmatch initial predicate) "Default method for reading file names. See `read-file-name' for the meaning of the arguments." === modified file 'lisp/simple.el' --- lisp/simple.el 2011-05-24 02:45:50 +0000 +++ lisp/simple.el 2011-05-31 03:03:38 +0000 @@ -1158,6 +1158,7 @@ (defvar minibuffer-completing-symbol nil "Non-nil means completing a Lisp symbol in the minibuffer.") +(make-obsolete-variable 'minibuffer-completing-symbol nil "24.1") (defvar minibuffer-default nil "The current default value or list of default values in the minibuffer. === modified file 'src/ChangeLog' --- src/ChangeLog 2011-05-31 02:12:01 +0000 +++ src/ChangeLog 2011-05-31 03:03:38 +0000 @@ -1,3 +1,12 @@ +2011-05-31 Stefan Monnier + + * minibuf.c (Finternal_complete_buffer): Return `category' metadata. + (read_minibuf): Use get_minibuffer. + (syms_of_minibuf): Use DEFSYM. + (Qmetadata): New var. + * data.c (Qbuffer): Don't make it static. + (syms_of_data): Use DEFSYM. + 2011-05-31 Paul Eggert * ccl.c (CCL_CODE_RANGE): Allow negative numbers. (Bug#8751) @@ -164,8 +173,8 @@ (symbol_to_x_atom): Remove gratuitous arg. (x_handle_selection_request, lisp_data_to_selection_data) (x_get_foreign_selection, Fx_register_dnd_atom): Callers changed. - (x_own_selection, x_get_local_selection, x_convert_selection): New - arg, specifying work frame. Use terminal-local Vselection_alist. + (x_own_selection, x_get_local_selection, x_convert_selection): + New arg, specifying work frame. Use terminal-local Vselection_alist. (some_frame_on_display): Delete unused function. (Fx_own_selection_internal, Fx_get_selection_internal) (Fx_disown_selection_internal, Fx_selection_owner_p) @@ -186,8 +195,8 @@ (x_selection_request_lisp_error): Free the above. (x_get_local_selection): Remove unnecessary code. (x_reply_selection_request): Args changed; handle arbitrary array - of converted selections stored in converted_selections. Separate - the XChangeProperty and SelectionNotify steps. + of converted selections stored in converted_selections. + Separate the XChangeProperty and SelectionNotify steps. (x_handle_selection_request): Rewrite to handle MULTIPLE target. (x_convert_selection): New function. (x_handle_selection_event): Simplify. @@ -351,8 +360,8 @@ Be more systematic about user-interface timestamps. Before, the code sometimes used 'Time', sometimes 'unsigned long', - and sometimes 'EMACS_UINT', to represent these timestamps. This - change causes it to use 'Time' uniformly, as that's what X uses. + and sometimes 'EMACS_UINT', to represent these timestamps. + This change causes it to use 'Time' uniformly, as that's what X uses. This makes the code easier to follow, and makes it easier to catch integer overflow bugs such as Bug#8664. * frame.c (Fmouse_position, Fmouse_pixel_position): === modified file 'src/data.c' --- src/data.c 2011-05-27 19:48:22 +0000 +++ src/data.c 2011-05-31 03:03:38 +0000 @@ -32,14 +32,14 @@ #include "keyboard.h" #include "frame.h" #include "syssignal.h" -#include "termhooks.h" /* For FRAME_KBOARD reference in y-or-n-p. */ +#include "termhooks.h" /* For FRAME_KBOARD reference in y-or-n-p. */ #include "font.h" #ifdef STDC_HEADERS #include #endif -/* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */ +/* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */ #ifndef IEEE_FLOATING_POINT #if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \ && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) @@ -90,7 +90,7 @@ Lisp_Object Qwindow; static Lisp_Object Qfloat, Qwindow_configuration; static Lisp_Object Qprocess; -static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector; +Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector; static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; static Lisp_Object Qsubrp, Qmany, Qunevalled; Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; @@ -2854,74 +2854,75 @@ { Lisp_Object error_tail, arith_tail; - Qquote = intern_c_string ("quote"); - Qlambda = intern_c_string ("lambda"); - Qsubr = intern_c_string ("subr"); - Qerror_conditions = intern_c_string ("error-conditions"); - Qerror_message = intern_c_string ("error-message"); - Qtop_level = intern_c_string ("top-level"); - - Qerror = intern_c_string ("error"); - Qquit = intern_c_string ("quit"); - Qwrong_type_argument = intern_c_string ("wrong-type-argument"); - Qargs_out_of_range = intern_c_string ("args-out-of-range"); - Qvoid_function = intern_c_string ("void-function"); - Qcyclic_function_indirection = intern_c_string ("cyclic-function-indirection"); - Qcyclic_variable_indirection = intern_c_string ("cyclic-variable-indirection"); - Qvoid_variable = intern_c_string ("void-variable"); - Qsetting_constant = intern_c_string ("setting-constant"); - Qinvalid_read_syntax = intern_c_string ("invalid-read-syntax"); - - Qinvalid_function = intern_c_string ("invalid-function"); - Qwrong_number_of_arguments = intern_c_string ("wrong-number-of-arguments"); - Qno_catch = intern_c_string ("no-catch"); - Qend_of_file = intern_c_string ("end-of-file"); - Qarith_error = intern_c_string ("arith-error"); - Qbeginning_of_buffer = intern_c_string ("beginning-of-buffer"); - Qend_of_buffer = intern_c_string ("end-of-buffer"); - Qbuffer_read_only = intern_c_string ("buffer-read-only"); - Qtext_read_only = intern_c_string ("text-read-only"); - Qmark_inactive = intern_c_string ("mark-inactive"); - - Qlistp = intern_c_string ("listp"); - Qconsp = intern_c_string ("consp"); - Qsymbolp = intern_c_string ("symbolp"); - Qkeywordp = intern_c_string ("keywordp"); - Qintegerp = intern_c_string ("integerp"); - Qnatnump = intern_c_string ("natnump"); - Qwholenump = intern_c_string ("wholenump"); - Qstringp = intern_c_string ("stringp"); - Qarrayp = intern_c_string ("arrayp"); - Qsequencep = intern_c_string ("sequencep"); - Qbufferp = intern_c_string ("bufferp"); - Qvectorp = intern_c_string ("vectorp"); - Qchar_or_string_p = intern_c_string ("char-or-string-p"); - Qmarkerp = intern_c_string ("markerp"); - Qbuffer_or_string_p = intern_c_string ("buffer-or-string-p"); - Qinteger_or_marker_p = intern_c_string ("integer-or-marker-p"); - Qboundp = intern_c_string ("boundp"); - Qfboundp = intern_c_string ("fboundp"); - - Qfloatp = intern_c_string ("floatp"); - Qnumberp = intern_c_string ("numberp"); - Qnumber_or_marker_p = intern_c_string ("number-or-marker-p"); - - Qchar_table_p = intern_c_string ("char-table-p"); - Qvector_or_char_table_p = intern_c_string ("vector-or-char-table-p"); - - Qsubrp = intern_c_string ("subrp"); - Qunevalled = intern_c_string ("unevalled"); - Qmany = intern_c_string ("many"); - - Qcdr = intern_c_string ("cdr"); - - /* Handle automatic advice activation */ - Qad_advice_info = intern_c_string ("ad-advice-info"); - Qad_activate_internal = intern_c_string ("ad-activate-internal"); + DEFSYM (Qquote, "quote"); + DEFSYM (Qlambda, "lambda"); + DEFSYM (Qsubr, "subr"); + DEFSYM (Qerror_conditions, "error-conditions"); + DEFSYM (Qerror_message, "error-message"); + DEFSYM (Qtop_level, "top-level"); + + DEFSYM (Qerror, "error"); + DEFSYM (Qquit, "quit"); + DEFSYM (Qwrong_type_argument, "wrong-type-argument"); + DEFSYM (Qargs_out_of_range, "args-out-of-range"); + DEFSYM (Qvoid_function, "void-function"); + DEFSYM (Qcyclic_function_indirection, "cyclic-function-indirection"); + DEFSYM (Qcyclic_variable_indirection, "cyclic-variable-indirection"); + DEFSYM (Qvoid_variable, "void-variable"); + DEFSYM (Qsetting_constant, "setting-constant"); + DEFSYM (Qinvalid_read_syntax, "invalid-read-syntax"); + + DEFSYM (Qinvalid_function, "invalid-function"); + DEFSYM (Qwrong_number_of_arguments, "wrong-number-of-arguments"); + DEFSYM (Qno_catch, "no-catch"); + DEFSYM (Qend_of_file, "end-of-file"); + DEFSYM (Qarith_error, "arith-error"); + DEFSYM (Qbeginning_of_buffer, "beginning-of-buffer"); + DEFSYM (Qend_of_buffer, "end-of-buffer"); + DEFSYM (Qbuffer_read_only, "buffer-read-only"); + DEFSYM (Qtext_read_only, "text-read-only"); + DEFSYM (Qmark_inactive, "mark-inactive"); + + DEFSYM (Qlistp, "listp"); + DEFSYM (Qconsp, "consp"); + DEFSYM (Qsymbolp, "symbolp"); + DEFSYM (Qkeywordp, "keywordp"); + DEFSYM (Qintegerp, "integerp"); + DEFSYM (Qnatnump, "natnump"); + DEFSYM (Qwholenump, "wholenump"); + DEFSYM (Qstringp, "stringp"); + DEFSYM (Qarrayp, "arrayp"); + DEFSYM (Qsequencep, "sequencep"); + DEFSYM (Qbufferp, "bufferp"); + DEFSYM (Qvectorp, "vectorp"); + DEFSYM (Qchar_or_string_p, "char-or-string-p"); + DEFSYM (Qmarkerp, "markerp"); + DEFSYM (Qbuffer_or_string_p, "buffer-or-string-p"); + DEFSYM (Qinteger_or_marker_p, "integer-or-marker-p"); + DEFSYM (Qboundp, "boundp"); + DEFSYM (Qfboundp, "fboundp"); + + DEFSYM (Qfloatp, "floatp"); + DEFSYM (Qnumberp, "numberp"); + DEFSYM (Qnumber_or_marker_p, "number-or-marker-p"); + + DEFSYM (Qchar_table_p, "char-table-p"); + DEFSYM (Qvector_or_char_table_p, "vector-or-char-table-p"); + + DEFSYM (Qsubrp, "subrp"); + DEFSYM (Qunevalled, "unevalled"); + DEFSYM (Qmany, "many"); + + DEFSYM (Qcdr, "cdr"); + + /* Handle automatic advice activation. */ + DEFSYM (Qad_advice_info, "ad-advice-info"); + DEFSYM (Qad_activate_internal, "ad-activate-internal"); error_tail = pure_cons (Qerror, Qnil); - /* ERROR is used as a signaler for random errors for which nothing else is right */ + /* ERROR is used as a signaler for random errors for which nothing else is + right. */ Fput (Qerror, Qerror_conditions, error_tail); @@ -2958,8 +2959,7 @@ Fput (Qcyclic_variable_indirection, Qerror_message, make_pure_c_string ("Symbol's chain of variable indirections contains a loop")); - Qcircular_list = intern_c_string ("circular-list"); - staticpro (&Qcircular_list); + DEFSYM (Qcircular_list, "circular-list"); Fput (Qcircular_list, Qerror_conditions, pure_cons (Qcircular_list, error_tail)); Fput (Qcircular_list, Qerror_message, @@ -3026,11 +3026,11 @@ Fput (Qtext_read_only, Qerror_message, make_pure_c_string ("Text is read-only")); - Qrange_error = intern_c_string ("range-error"); - Qdomain_error = intern_c_string ("domain-error"); - Qsingularity_error = intern_c_string ("singularity-error"); - Qoverflow_error = intern_c_string ("overflow-error"); - Qunderflow_error = intern_c_string ("underflow-error"); + DEFSYM (Qrange_error, "range-error"); + DEFSYM (Qdomain_error, "domain-error"); + DEFSYM (Qsingularity_error, "singularity-error"); + DEFSYM (Qoverflow_error, "overflow-error"); + DEFSYM (Qunderflow_error, "underflow-error"); Fput (Qdomain_error, Qerror_conditions, pure_cons (Qdomain_error, arith_tail)); @@ -3057,93 +3057,29 @@ Fput (Qunderflow_error, Qerror_message, make_pure_c_string ("Arithmetic underflow error")); - staticpro (&Qrange_error); - staticpro (&Qdomain_error); - staticpro (&Qsingularity_error); - staticpro (&Qoverflow_error); - staticpro (&Qunderflow_error); - staticpro (&Qnil); staticpro (&Qt); - staticpro (&Qquote); - staticpro (&Qlambda); - staticpro (&Qsubr); staticpro (&Qunbound); - staticpro (&Qerror_conditions); - staticpro (&Qerror_message); - staticpro (&Qtop_level); - - staticpro (&Qerror); - staticpro (&Qquit); - staticpro (&Qwrong_type_argument); - staticpro (&Qargs_out_of_range); - staticpro (&Qvoid_function); - staticpro (&Qcyclic_function_indirection); - staticpro (&Qcyclic_variable_indirection); - staticpro (&Qvoid_variable); - staticpro (&Qsetting_constant); - staticpro (&Qinvalid_read_syntax); - staticpro (&Qwrong_number_of_arguments); - staticpro (&Qinvalid_function); - staticpro (&Qno_catch); - staticpro (&Qend_of_file); - staticpro (&Qarith_error); - staticpro (&Qbeginning_of_buffer); - staticpro (&Qend_of_buffer); - staticpro (&Qbuffer_read_only); - staticpro (&Qtext_read_only); - staticpro (&Qmark_inactive); - - staticpro (&Qlistp); - staticpro (&Qconsp); - staticpro (&Qsymbolp); - staticpro (&Qkeywordp); - staticpro (&Qintegerp); - staticpro (&Qnatnump); - staticpro (&Qwholenump); - staticpro (&Qstringp); - staticpro (&Qarrayp); - staticpro (&Qsequencep); - staticpro (&Qbufferp); - staticpro (&Qvectorp); - staticpro (&Qchar_or_string_p); - staticpro (&Qmarkerp); - staticpro (&Qbuffer_or_string_p); - staticpro (&Qinteger_or_marker_p); - staticpro (&Qfloatp); - staticpro (&Qnumberp); - staticpro (&Qnumber_or_marker_p); - staticpro (&Qchar_table_p); - staticpro (&Qvector_or_char_table_p); - staticpro (&Qsubrp); - staticpro (&Qmany); - staticpro (&Qunevalled); - - staticpro (&Qboundp); - staticpro (&Qfboundp); - staticpro (&Qcdr); - staticpro (&Qad_advice_info); - staticpro (&Qad_activate_internal); /* Types that type-of returns. */ - Qinteger = intern_c_string ("integer"); - Qsymbol = intern_c_string ("symbol"); - Qstring = intern_c_string ("string"); - Qcons = intern_c_string ("cons"); - Qmarker = intern_c_string ("marker"); - Qoverlay = intern_c_string ("overlay"); - Qfloat = intern_c_string ("float"); - Qwindow_configuration = intern_c_string ("window-configuration"); - Qprocess = intern_c_string ("process"); - Qwindow = intern_c_string ("window"); - /* Qsubr = intern_c_string ("subr"); */ - Qcompiled_function = intern_c_string ("compiled-function"); - Qbuffer = intern_c_string ("buffer"); - Qframe = intern_c_string ("frame"); - Qvector = intern_c_string ("vector"); - Qchar_table = intern_c_string ("char-table"); - Qbool_vector = intern_c_string ("bool-vector"); - Qhash_table = intern_c_string ("hash-table"); + DEFSYM (Qinteger, "integer"); + DEFSYM (Qsymbol, "symbol"); + DEFSYM (Qstring, "string"); + DEFSYM (Qcons, "cons"); + DEFSYM (Qmarker, "marker"); + DEFSYM (Qoverlay, "overlay"); + DEFSYM (Qfloat, "float"); + DEFSYM (Qwindow_configuration, "window-configuration"); + DEFSYM (Qprocess, "process"); + DEFSYM (Qwindow, "window"); + /* DEFSYM (Qsubr, "subr"); */ + DEFSYM (Qcompiled_function, "compiled-function"); + DEFSYM (Qbuffer, "buffer"); + DEFSYM (Qframe, "frame"); + DEFSYM (Qvector, "vector"); + DEFSYM (Qchar_table, "char-table"); + DEFSYM (Qbool_vector, "bool-vector"); + DEFSYM (Qhash_table, "hash-table"); DEFSYM (Qfont_spec, "font-spec"); DEFSYM (Qfont_entity, "font-entity"); @@ -3151,25 +3087,6 @@ DEFSYM (Qinteractive_form, "interactive-form"); - staticpro (&Qinteger); - staticpro (&Qsymbol); - staticpro (&Qstring); - staticpro (&Qcons); - staticpro (&Qmarker); - staticpro (&Qoverlay); - staticpro (&Qfloat); - staticpro (&Qwindow_configuration); - staticpro (&Qprocess); - staticpro (&Qwindow); - /* staticpro (&Qsubr); */ - staticpro (&Qcompiled_function); - staticpro (&Qbuffer); - staticpro (&Qframe); - staticpro (&Qvector); - staticpro (&Qchar_table); - staticpro (&Qbool_vector); - staticpro (&Qhash_table); - defsubr (&Sindirect_variable); defsubr (&Sinteractive_form); defsubr (&Seq); === modified file 'src/minibuf.c' --- src/minibuf.c 2011-05-12 07:07:06 +0000 +++ src/minibuf.c 2011-05-31 03:03:38 +0000 @@ -43,7 +43,7 @@ Lisp_Object Vminibuffer_list; -/* Data to remember during recursive minibuffer invocations */ +/* Data to remember during recursive minibuffer invocations. */ static Lisp_Object minibuf_save_list; @@ -55,7 +55,7 @@ static Lisp_Object Qhistory_length; -/* Fread_minibuffer leaves the input here as a string. */ +/* Fread_minibuffer leaves the input here as a string. */ Lisp_Object last_minibuf_string; @@ -588,7 +588,7 @@ /* Empty out the minibuffers of all frames other than the one where we are going to display one now. Set them to point to ` *Minibuf-0*', which is always empty. */ - empty_minibuf = Fget_buffer (build_string (" *Minibuf-0*")); + empty_minibuf = get_minibuffer (0); FOR_EACH_FRAME (dummy, frame) { @@ -1137,8 +1137,8 @@ } result = Fcompleting_read (prompt, intern ("internal-complete-buffer"), - Qnil, require_match, Qnil, Qbuffer_name_history, - def, Qnil); + Qnil, require_match, Qnil, + Qbuffer_name_history, def, Qnil); } else { @@ -1878,6 +1878,9 @@ return Qt; } +Lisp_Object Qmetadata; +extern Lisp_Object Qbuffer; + DEFUN ("internal-complete-buffer", Finternal_complete_buffer, Sinternal_complete_buffer, 3, 3, 0, doc: /* Perform completion on buffer names. If the argument FLAG is nil, invoke `try-completion', if it's t, invoke @@ -1912,8 +1915,12 @@ return res; } } - else /* assume `lambda' */ + else if (EQ (flag, Qlambda)) return Ftest_completion (string, Vbuffer_alist, predicate); + else if (EQ (flag, Qmetadata)) + return Fcons (Qmetadata, Fcons (Fcons (Qcategory, Qbuffer), Qnil)); + else + return Qnil; } /* Like assoc but assumes KEY is a string, and ignores case if appropriate. */ @@ -1989,66 +1996,38 @@ minibuf_save_list = Qnil; staticpro (&minibuf_save_list); - Qcompleting_read_default = intern_c_string ("completing-read-default"); - staticpro (&Qcompleting_read_default); - - Qcompletion_ignore_case = intern_c_string ("completion-ignore-case"); - staticpro (&Qcompletion_ignore_case); - - Qread_file_name_internal = intern_c_string ("read-file-name-internal"); - staticpro (&Qread_file_name_internal); - - Qminibuffer_default = intern_c_string ("minibuffer-default"); - staticpro (&Qminibuffer_default); + DEFSYM (Qcompleting_read_default, "completing-read-default"); + DEFSYM (Qcompletion_ignore_case, "completion-ignore-case"); + DEFSYM (Qread_file_name_internal, "read-file-name-internal"); + DEFSYM (Qminibuffer_default, "minibuffer-default"); Fset (Qminibuffer_default, Qnil); - Qminibuffer_completion_table = intern_c_string ("minibuffer-completion-table"); - staticpro (&Qminibuffer_completion_table); - - Qminibuffer_completion_confirm = intern_c_string ("minibuffer-completion-confirm"); - staticpro (&Qminibuffer_completion_confirm); - - Qminibuffer_completion_predicate = intern_c_string ("minibuffer-completion-predicate"); - staticpro (&Qminibuffer_completion_predicate); + DEFSYM (Qminibuffer_completion_table, "minibuffer-completion-table"); + DEFSYM (Qminibuffer_completion_confirm, "minibuffer-completion-confirm"); + DEFSYM (Qminibuffer_completion_predicate, "minibuffer-completion-predicate"); staticpro (&last_minibuf_string); last_minibuf_string = Qnil; - Quser_variable_p = intern_c_string ("user-variable-p"); - staticpro (&Quser_variable_p); - - Qminibuffer_history = intern_c_string ("minibuffer-history"); - staticpro (&Qminibuffer_history); - - Qbuffer_name_history = intern_c_string ("buffer-name-history"); - staticpro (&Qbuffer_name_history); + DEFSYM (Quser_variable_p, "user-variable-p"); + DEFSYM (Qminibuffer_history, "minibuffer-history"); + DEFSYM (Qbuffer_name_history, "buffer-name-history"); Fset (Qbuffer_name_history, Qnil); - Qminibuffer_setup_hook = intern_c_string ("minibuffer-setup-hook"); - staticpro (&Qminibuffer_setup_hook); - - Qminibuffer_exit_hook = intern_c_string ("minibuffer-exit-hook"); - staticpro (&Qminibuffer_exit_hook); - - Qhistory_length = intern_c_string ("history-length"); - staticpro (&Qhistory_length); - - Qcurrent_input_method = intern_c_string ("current-input-method"); - staticpro (&Qcurrent_input_method); - - Qactivate_input_method = intern_c_string ("activate-input-method"); - staticpro (&Qactivate_input_method); - - Qcase_fold_search = intern_c_string ("case-fold-search"); - staticpro (&Qcase_fold_search); + DEFSYM (Qminibuffer_setup_hook, "minibuffer-setup-hook"); + DEFSYM (Qminibuffer_exit_hook, "minibuffer-exit-hook"); + DEFSYM (Qhistory_length, "history-length"); + DEFSYM (Qcurrent_input_method, "current-input-method"); + DEFSYM (Qactivate_input_method, "activate-input-method"); + DEFSYM (Qcase_fold_search, "case-fold-search"); + DEFSYM (Qmetadata, "metadata"); DEFVAR_LISP ("read-expression-history", Vread_expression_history, doc: /* A history list for arguments that are Lisp expressions to evaluate. For example, `eval-expression' uses this. */); Vread_expression_history = Qnil; - Qread_expression_history = intern_c_string ("read-expression-history"); - staticpro (&Qread_expression_history); + DEFSYM (Qread_expression_history, "read-expression-history"); DEFVAR_LISP ("read-buffer-function", Vread_buffer_function, doc: /* If this is non-nil, `read-buffer' does its work by calling this function. ------------------------------------------------------------ revno: 104441 fixes bug(s): http://debbugs.gnu.org/8751 committer: Paul Eggert branch nick: trunk timestamp: Mon 2011-05-30 19:12:01 -0700 message: * ccl.c (CCL_CODE_RANGE): Allow negative numbers. (Bug#8751) (CCL_CODE_MIN): New macro. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-05-30 16:09:29 +0000 +++ src/ChangeLog 2011-05-31 02:12:01 +0000 @@ -1,3 +1,8 @@ +2011-05-31 Paul Eggert + + * ccl.c (CCL_CODE_RANGE): Allow negative numbers. (Bug#8751) + (CCL_CODE_MIN): New macro. + 2011-05-30 Paul Eggert * alloc.c (lisp_align_malloc): Omit unnecessary val==NULL tests. === modified file 'src/ccl.c' --- src/ccl.c 2011-05-27 21:24:11 +0000 +++ src/ccl.c 2011-05-31 02:12:01 +0000 @@ -79,9 +79,8 @@ #define CCL_HEADER_EOF 1 #define CCL_HEADER_MAIN 2 -/* CCL code is a sequence of 28-bit non-negative integers (i.e. the - MSB is always 0), each contains CCL command and/or arguments in the - following format: +/* CCL code is a sequence of 28-bit integers. Each contains a CCL + command and/or arguments in the following format: |----------------- integer (28-bit) ------------------| |------- 17-bit ------|- 3-bit --|- 3-bit --|- 5-bit -| @@ -94,12 +93,14 @@ |------------- constant or other args ----------------| cccccccccccccccccccccccccccc - where, `cc...c' is a non-negative integer indicating constant value - (the left most `c' is always 0) or an absolute jump address, `RRR' + where `cc...c' is an integer indicating a constant value or an + absolute jump address. The context determines whether `cc...c' is + considered to be unsigned, or a signed two's complement number. `RRR' and `rrr' are CCL register number, `XXXXX' is one of the following CCL commands. */ #define CCL_CODE_MAX ((1 << (28 - 1)) - 1) +#define CCL_CODE_MIN (-1 - CCL_CODE_MAX) /* CCL commands @@ -756,7 +757,7 @@ while (0) #define GET_CCL_CODE(code, ccl_prog, ic) \ - GET_CCL_RANGE (code, ccl_prog, ic, 0, CCL_CODE_MAX) + GET_CCL_RANGE (code, ccl_prog, ic, CCL_CODE_MIN, CCL_CODE_MAX) #define GET_CCL_INT(var, ccl_prog, ic) \ GET_CCL_RANGE (var, ccl_prog, ic, INT_MIN, INT_MAX) ------------------------------------------------------------ revno: 104440 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Mon 2011-05-30 22:11:52 +0000 message: Merge changes made in Gnus trunk. gnus-group.el (gnus-group-mark-article-read): It's possible that we want to have `gnus-newsgroup-unselected' kept sorted. If this isn't done, then unselected articles may be marked as read. pop3.el (pop3-open-server): Erase the buffer after the greeting, since not doing this seems to lead to a race condition in pop3-logon. nnvirtual.el (nnvirtual-request-article): Bind `gnus-command-method' so that the call chain it correct when we call "upwards". gnus-sum.el (gnus-select-newsgroup): Auto-expiry doesn't make sense in read-only groups. gnus-group.el (gnus-group-mark-article-read): Ditto. message.el (message-cite-reply-position): Doc string fix. nnimap.el (nnimap-transform-headers): Simplify regexp to hopefully avoid regexp overflow. (nnimap-transform-split-mail): Ditto. pop3.el (pop3-retr): Error out if the server closes the connection. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2011-05-30 17:21:59 +0000 +++ lisp/gnus/ChangeLog 2011-05-30 22:11:52 +0000 @@ -1,3 +1,28 @@ +2011-05-30 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-mark-article-read): It's possible that we + want to have `gnus-newsgroup-unselected' kept sorted. If this isn't + done, then unselected articles may be marked as read. + + * pop3.el (pop3-open-server): Erase the buffer after the greeting, + since not doing this seems to lead to a race condition in pop3-logon. + + * nnvirtual.el (nnvirtual-request-article): Bind `gnus-command-method' + so that the call chain it correct when we call "upwards". + + * gnus-sum.el (gnus-select-newsgroup): Auto-expiry doesn't make sense + in read-only groups. + + * gnus-group.el (gnus-group-mark-article-read): Ditto. + + * message.el (message-cite-reply-position): Doc string fix. + + * nnimap.el (nnimap-transform-headers): Simplify regexp to hopefully + avoid regexp overflow. + (nnimap-transform-split-mail): Ditto. + + * pop3.el (pop3-retr): Error out if the server closes the connection. + 2011-05-30 Stefan Monnier * mml1991.el (mml1991-mailcrypt-encrypt): Remove use of ill-designed === modified file 'lisp/gnus/gnus-group.el' --- lisp/gnus/gnus-group.el 2011-05-27 00:55:07 +0000 +++ lisp/gnus/gnus-group.el 2011-05-30 22:11:52 +0000 @@ -3567,7 +3567,8 @@ (gnus-add-marked-articles group 'tick nil nil 'force) (gnus-add-marked-articles group 'dormant nil nil 'force)) ;; Do auto-expirable marks if that's required. - (when (gnus-group-auto-expirable-p group) + (when (and (gnus-group-auto-expirable-p group) + (not (gnus-group-read-only-p group))) (gnus-range-map (lambda (article) (gnus-add-marked-articles group 'expire (list article)) @@ -4630,10 +4631,11 @@ (push n gnus-newsgroup-unselected)) (setq n (1+ n))) (setq gnus-newsgroup-unselected - (nreverse gnus-newsgroup-unselected))))) + (sort gnus-newsgroup-unselected '<))))) (gnus-activate-group group) (gnus-group-make-articles-read group (list article)) - (when (gnus-group-auto-expirable-p group) + (when (and (gnus-group-auto-expirable-p group) + (not (gnus-group-read-only-p group))) (gnus-add-marked-articles group 'expire (list article)))))) === modified file 'lisp/gnus/gnus-sum.el' --- lisp/gnus/gnus-sum.el 2011-05-20 01:00:46 +0000 +++ lisp/gnus/gnus-sum.el 2011-05-30 22:11:52 +0000 @@ -5715,7 +5715,8 @@ (gnus-summary-remove-list-identifiers) ;; Check whether auto-expire is to be done in this group. (setq gnus-newsgroup-auto-expire - (gnus-group-auto-expirable-p group)) + (and (gnus-group-auto-expirable-p group) + (not (gnus-group-read-only-p group)))) ;; Set up the article buffer now, if necessary. (unless (and gnus-single-article-buffer (equal gnus-article-buffer "*Article*")) === modified file 'lisp/gnus/message.el' --- lisp/gnus/message.el 2011-05-13 02:16:09 +0000 +++ lisp/gnus/message.el 2011-05-30 22:11:52 +0000 @@ -1091,7 +1091,7 @@ probably want to set this variable only for specific groups, e.g. using `gnus-posting-styles': - (eval (set (make-local-variable 'message-cite-reply-above) 'above))" + (eval (set (make-local-variable 'message-cite-reply-position) 'above))" :type '(choice (const :tag "Reply inline" 'traditional) (const :tag "Reply above" 'above) (const :tag "Reply below" 'below)) === modified file 'lisp/gnus/nnimap.el' --- lisp/gnus/nnimap.el 2011-05-02 03:37:06 +0000 +++ lisp/gnus/nnimap.el 2011-05-30 22:11:52 +0000 @@ -190,7 +190,7 @@ (let (article bytes lines size string) (block nil (while (not (eobp)) - (while (not (looking-at "^\\* [0-9]+ FETCH.*UID \\([0-9]+\\)")) + (while (not (looking-at "\\* [0-9]+ FETCH.+UID \\([0-9]+\\)")) (delete-region (point) (progn (forward-line 1) (point))) (when (eobp) (return))) @@ -1904,7 +1904,7 @@ (let (article bytes) (block nil (while (not (eobp)) - (while (not (looking-at "^\\* [0-9]+ FETCH.*UID \\([0-9]+\\)")) + (while (not (looking-at "\\* [0-9]+ FETCH.+UID \\([0-9]+\\)")) (delete-region (point) (progn (forward-line 1) (point))) (when (eobp) (return))) === modified file 'lisp/gnus/nnvirtual.el' --- lisp/gnus/nnvirtual.el 2011-01-25 04:08:28 +0000 +++ lisp/gnus/nnvirtual.el 2011-05-30 22:11:52 +0000 @@ -194,10 +194,11 @@ (when buffer (set-buffer buffer)) (let* ((gnus-override-method nil) - (method (gnus-find-method-for-group - nnvirtual-last-accessed-component-group))) - (funcall (gnus-get-function method 'request-article) - article nil (nth 1 method) buffer))))) + (gnus-command-method + (gnus-find-method-for-group + nnvirtual-last-accessed-component-group))) + (funcall (gnus-get-function gnus-command-method 'request-article) + article nil (nth 1 gnus-command-method) buffer))))) ;; This is a fetch by number. (let* ((amap (nnvirtual-map-article article)) (cgroup (car amap))) === modified file 'lisp/gnus/pop3.el' --- lisp/gnus/pop3.el 2011-05-02 01:45:17 +0000 +++ lisp/gnus/pop3.el 2011-05-30 22:11:52 +0000 @@ -319,6 +319,7 @@ (substring response (or (string-match "<" response) 0) (+ 1 (or (string-match ">" response) -1))))) (pop3-set-process-query-on-exit-flag (car result) nil) + (erase-buffer) (car result))))) ;; Support functions @@ -514,6 +515,8 @@ (let ((start pop3-read-point) end) (with-current-buffer (process-buffer process) (while (not (re-search-forward "^\\.\r\n" nil t)) + (unless (memq (process-status process) '(open run)) + (error "pop3 server closed the connection")) (pop3-accept-process-output process) (goto-char start)) (setq pop3-read-point (point-marker)) ------------------------------------------------------------ revno: 104439 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2011-05-30 14:23:47 -0300 message: * lisp/mail/smtpmail.el (smtpmail-send-data): Add progress reporter. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-30 12:23:56 +0000 +++ lisp/ChangeLog 2011-05-30 17:23:47 +0000 @@ -1,3 +1,7 @@ +2011-05-30 Stefan Monnier + + * mail/smtpmail.el (smtpmail-send-data): Add progress reporter. + 2011-05-30 Leo Liu * net/rcirc.el (rcirc-debug-buffer): Use visible buffer name. === modified file 'lisp/mail/smtpmail.el' --- lisp/mail/smtpmail.el 2011-05-24 03:54:18 +0000 +++ lisp/mail/smtpmail.el 2011-05-30 17:23:47 +0000 @@ -943,15 +943,20 @@ (process-send-string process "\r\n")) (defun smtpmail-send-data (process buffer) - (let ((data-continue t) sending-data) + (let ((data-continue t) sending-data + (pr (with-current-buffer buffer + (make-progress-reporter "Sending email" + (point-min) (point-max))))) (with-current-buffer buffer (goto-char (point-min))) (while data-continue (with-current-buffer buffer + (progress-reporter-update pr (point)) (setq sending-data (buffer-substring (point-at-bol) (point-at-eol))) (end-of-line 2) (setq data-continue (not (eobp)))) - (smtpmail-send-data-1 process sending-data)))) + (smtpmail-send-data-1 process sending-data)) + (progress-reporter-done pr))) (defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end) "Get address list suitable for smtp RCPT TO:
." ------------------------------------------------------------ revno: 104438 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2011-05-30 14:21:59 -0300 message: * lisp/gnus/mml1991.el (mml1991-mailcrypt-encrypt): Remove use of ill-designed mm-with-unibyte-current-buffer. The buffer should not contain any multibyte chars anyway at this stage. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2011-05-29 23:28:45 +0000 +++ lisp/gnus/ChangeLog 2011-05-30 17:21:59 +0000 @@ -1,3 +1,9 @@ +2011-05-30 Stefan Monnier + + * mml1991.el (mml1991-mailcrypt-encrypt): Remove use of ill-designed + mm-with-unibyte-current-buffer. The buffer should not contain any + multibyte chars anyway at this stage. + 2011-05-29 Lars Magne Ingebrigtsen * shr.el (shr-urlify): Use shr-add-font to make underlines be less ugly === modified file 'lisp/gnus/mml1991.el' --- lisp/gnus/mml1991.el 2011-01-25 04:08:28 +0000 +++ lisp/gnus/mml1991.el 2011-05-30 17:21:59 +0000 @@ -137,33 +137,32 @@ (while (looking-at "^Content[^ ]+:") (forward-line)) (unless (bobp) (delete-region (point-min) (point))) - (mm-with-unibyte-current-buffer - (with-temp-buffer - (inline (mm-disable-multibyte)) - (setq cipher (current-buffer)) - (insert-buffer-substring text) - (unless (mc-encrypt-generic - (or - (message-options-get 'message-recipients) - (message-options-set 'message-recipients - (read-string "Recipients: "))) - nil - (point-min) (point-max) - (message-options-get 'message-sender) - 'sign) - (unless (> (point-max) (point-min)) - (pop-to-buffer result-buffer) - (error "Encrypt error"))) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (set-buffer text) - (delete-region (point-min) (point-max)) - ;;(insert "Content-Type: application/pgp-encrypted\n\n") - ;;(insert "Version: 1\n\n") - (insert "\n") - (insert-buffer-substring cipher) - (goto-char (point-max)))))) + (with-temp-buffer + (inline (mm-disable-multibyte)) + (setq cipher (current-buffer)) + (insert-buffer-substring text) + (unless (mc-encrypt-generic + (or + (message-options-get 'message-recipients) + (message-options-set 'message-recipients + (read-string "Recipients: "))) + nil + (point-min) (point-max) + (message-options-get 'message-sender) + 'sign) + (unless (> (point-max) (point-min)) + (pop-to-buffer result-buffer) + (error "Encrypt error"))) + (goto-char (point-min)) + (while (re-search-forward "\r+$" nil t) + (replace-match "" t t)) + (set-buffer text) + (delete-region (point-min) (point-max)) + ;;(insert "Content-Type: application/pgp-encrypted\n\n") + ;;(insert "Version: 1\n\n") + (insert "\n") + (insert-buffer-substring cipher) + (goto-char (point-max))))) ;; pgg wrapper ------------------------------------------------------------ revno: 104437 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2011-05-30 14:14:19 -0300 message: * bytecomp.el (byte-compile-defvar): Add note about quoted lambda. diff: === modified file 'lisp/emacs-lisp/bytecomp.el' --- lisp/emacs-lisp/bytecomp.el 2011-05-23 01:15:17 +0000 +++ lisp/emacs-lisp/bytecomp.el 2011-05-30 17:14:19 +0000 @@ -4155,6 +4155,8 @@ (if (eq fun 'defconst) ;; `defconst' sets `var' unconditionally. (let ((tmp (make-symbol "defconst-tmp-var"))) + ;; Quote with `quote' to prevent byte-compiling the body, + ;; which would lead to an inf-loop. `(funcall '(lambda (,tmp) (defconst ,var ,tmp)) ,value)) ;; `defvar' sets `var' only when unbound. ------------------------------------------------------------ revno: 104436 author: Oliver Scholz committer: Stefan Monnier branch nick: trunk timestamp: Mon 2011-05-30 13:25:33 -0300 message: * leim/quail/ipa-praat.el: New input method. diff: === modified file 'leim/ChangeLog' --- leim/ChangeLog 2011-05-16 13:57:10 +0000 +++ leim/ChangeLog 2011-05-30 16:25:33 +0000 @@ -1,3 +1,7 @@ +2011-05-30 Oliver Scholz + + * quail/ipa-praat.el: New input method. + 2011-05-16 Eli Zaretskii * Makefile.in (OTHERS): Add $(srcdir)/quail/persian.elc. === added file 'leim/quail/ipa-praat.el' --- leim/quail/ipa-praat.el 1970-01-01 00:00:00 +0000 +++ leim/quail/ipa-praat.el 2011-05-30 16:25:33 +0000 @@ -0,0 +1,346 @@ +;;; ipa-praat.el --- Inputting IPA characters with the conventions of Praat + +;; Copyright (C) 2011 Free Software Foundation, Inc. + +;; Author: Oliver Scholz +;; Keywords: multilingual, input method, IPA + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This is a new input method for IPA characters and diacritics, which follows +;; the conventions of Praat, a GPLed program for phonetical analysis. +;; +;; This input method is much more complete than the current ipa.el. + +;;; Code: + +(require 'quail) + +(quail-define-package + "ipa-praat" "IPA" "IPAP" t + "International Phonetic Alphabet input method. +This follows the input method of the phonetical analysis program +Praat (http://www.fon.hum.uva.nl/praat/). + + +* Vowels + +- Unrounded + | front | centr. | back +-------------+-------+--------+------ +close | i i | ɨ \\i- | ɯ \\mt +close centr. | ɪ \\ic | | +close-mid | e e | ɘ \\e- | ɤ \\rh + | | ə \\sw | +open-mid | ɛ \\ef | ɜ \\er | ʌ \\vt + | æ \\ae | ɐ \\at | +open | a a | | ɑ \\as + + + +- Rounded + | front | centr. | back +-------------+-------+--------+------- +close | y y | ʉ \\u- | u u +close centr. | ʏ \\yc | | ʊ \\hs +close-mid | ø \\o/ | ɵ \\o- | o o +open-mid | œ \\oe | ɞ \\kb | ɔ \\ct +open | ɶ \\Oe | | ɒ \\ab + + + +For most of the codes, the first letter tells you the most +similar letter of the English alphabet. The second letter can be +t (turned), c (capital), s (script), r (reversed), - (barred or +retracted), or / (slashed). One symbol (ɛ) is a phonetic version +of a Greek letter. The codes for ə, ɤ, ʊ and ɞ are abbreviations +for schwa, ram's horn, horseshoe, and kidney bean. + + +* Consonants + +- Pulmonic + + | plos. | nasal | fric. | approx. | trill | tap/flap | l. appr. +-----------+-------+-------+-------+---------+-------+----------+--------- +bilabial | p p | m m | ɸ \\ff | | | | + | b b | | β \\bf | ʋ \\vs | ʙ \\bc | | +labiodent. | | ɱ \\mj | f f | | | | + | | | v v | | | | +dental | | | θ \\tf | | | | + | | | ð \\dh | | | | +alveolar | t t | n n | s s | | | ɾ \\fh | + | d d | | z z | ɹ \\rt | r r | | l l +alv. lat. | | | ɬ \\l- | | | ɺ \\rl | + | | | ɮ \\lz | l l | | | l l +postalv. | | | ʃ \\sh | | | | + | | | ʒ \\zh | | | | +retroflex | ʈ \\t. | ɳ \\n. | ʂ \\s. | | | ɽ \\f. | + | ɖ \\d. | | ʐ \\z. | ɻ \\r. | | | ɭ \\l. +alv.-pala. | | | ɕ \\cc | | | | + | | | ʑ \\zc | | | | +palatal | c c | ɲ \\nj | ç \\c, | | | | + | ɟ \\j. | | ʝ \\jc | j j | | | ʎ \\yt +lab-pal. | | | | | | | + | | | | ɥ \\ht | | | +lab.-vela. | | | ʍ \\wt | | | | + | | | | w w | | | +velar | k k | ŋ \\ng | x x | | | | ʟ \\lc + | ɡ \\gs | | ɣ \\gf | ɰ \\ml | | | +uvular | q q | ɴ \\nc | χ \\cf | | | | + | ɢ \\gc | | ʁ \\ri | | ʀ \\rc | | +pharyngeal | | | ħ \\h- | | | | + | | | ʕ \\9e | | | | +epiglottal | ʡ \\?- | | ʜ \\hc | | | | + | | | ʢ \\9- | | | | +glottal | ʔ | | h h | | | | + | | | ɦ \\h^ | | | | + +- Nonpulmonic + + | implosive | click +----------+-----------+------ +bilabial | ɓ \\b^ | ʘ \\O. +dental | | ǀ \\|1 +alveolar | ɗ \\d^ | +alv.-lat. | | ǁ \\|2 +postalv. | | ǂ \\|- +retrofl. | | ! ! +palatal | ʄ \\j^ | +velar | ɠ \\g^ | +uvular | ʛ \\G^ | + +For most of the codes, the first letter tells you the most +similar letter of the English alphabet. The second letter can be +t (turned), c (capital or curled), s (script), - (barred), +l (with leg), i (inverted), or j (left tail). Some phonetic +symbols are similar to Greek letters but have special +phonetic (f) versions with serifs (ɸ, β, ɣ) or are otherwise +slightly different (θ, χ). The codes for ŋ (engma), ð (eth), +ʃ (esh), and ʒ (yogh) are traditional alternative spellings. The +retroflexes have a period in the second place, because an +alternative traditional spelling is to write a dot under +them. The code for ɾ is an abbreviation for fishhook. + + +* Diacritics + +- In line + +input | example | description +------+---------+--------------------- +\\:f | ː | phonetic length sign +\\'1 | ˈ | primary stress +\\'2 | ˌ | secondary stress +\\cn | t̚ | unreleased plosive +\\rh | ɜ˞ | rhotacized vowel + +- Understrikes + +input | example | description +------+---------+-------------------------------- +\\|v | n̩ | syllabic consonant +\\0v | b̥ | voiceless +\\Tv | o̞ | lowered +\\T^ | o̝ | raised +\\T( | o̘ | advanced tongue root +\\T) | o̙ | retracted tongue root +\\-v | e̱ | backed +\\+v | o̟ | fronted +\\:v | o̤ | breathy voice +\\~v | o̰ | creaky voice +\\Nv | d̪ | dental (as opposed to alveolar) +\\Uv | d̺ | apical +\\Dv | d̻ | laminal +\\nv | u̯ | nonsyllabic +\\e3v | e̹ | slightly rounded +\\cv | u̜ | slightly unrounded + +- Overstrikes + +input | example | description +------+---------+-------------------------------------------- +\\0^ | ɣ̊ | voiceless +\\'^ | | high tone +\\`^ | | low tone +\\-^ | | mid tone +\\~^ | | nasalized +\\v^ | | rising tone +\\^^ | | falling tone +\\:^ | | centralized +\\N^ | | short +\\li | k͡p | simultaneous articulation or single segment +" + nil t nil nil nil nil nil nil nil nil t) + +(quail-define-rules + ;; plosives + ("\\t." ?ʈ) ; retroflex + ("\\d." ?ɖ) ; voiced retroflex + ("\\j-" ?ɟ) ; voiced palatal + ("\\gs" ?ɡ) ; voiced velar + ("\\gc" ?ɢ) ; voiced uvular + ("\\?-" ?ʡ) ; epiglottal + ("\\?g" ?ʔ) ; glottal + + ;; nasals + ("\\mj" ?ɱ) ; labiodental + ("\\n." ?ɳ) ; retroflex + ("\\nj" ?ɲ) ; palatal + ("\\ng" ?ŋ) ; velar + ("\\nc" ?ɴ) ; uvular + + ;; fricatives + ("\\ff" ?ɸ) ; bilabial + ("\\bf" ?β) ; voiced bilabial + ("\\tf" ?θ) ; labiodental + ("\\dh" ?ð) ; voiced labiodental + ("\\sh" ?ʃ) ; postalveolar + ("\\l-" ?ɬ) ; alv. lateral + ("\\lz" ?ɮ) ; voiced alv. lateral + ("\\zh" ?ʒ) ; voiced postalveolar + ("\\s." ?ʂ) ; retroflex + ("\\z." ?ʐ) ; voiced retroflex + ("\\cc" ?ɕ) ; alveolo-palatal + ("\\zc" ?ʑ) ; voiced alveolo-palatal + ("\\c," ?ç) ; palatal + ("\\jc" ?ʝ) ; voiced palatal + ("\\wt" ?ʍ) ; labial-velar + ("\\gf" ?ɣ) ; voiced velar + ("\\cf" ?χ) ; uvular + ("\\ri" ?ʁ) ; voiced uvular + ("\\h-" ?ħ) ; pharyngeal + ("\\9e" ?ʕ) ; voiced pharyngeal + ("\\hc" ?ʜ) ; epiglottal + ("\\9-" ?ʢ) ; voiced epiglottal + ("\\h^" ?ɦ) ; voiced glottal + + ;; approximants + ("\\vs" ?ʋ) ; labiodental + ("\\rt" ?ɹ) ; alveolar + ("\\r." ?ɻ) ; retroflex + ("\\ht" ?ɥ) ; labial-palatal + ("\\ml" ?ɰ) ; velar + + ;; trills + ("\\bc" ?ʙ) ; bilabial + ("\\rc" ?ʀ) ; uvular + + ;; taps or flaps + ; ⱱ -- labiodental + ("\\fh" ?ɾ) ; alveolar + ("\\rl" ?ɺ) ; alv.-lateral + ("\\f." ?ɽ) ; retroflex + + ;; lateral approx. + ("\\l." ?ɭ) ; retroflex + ("\\yt" ?ʎ) ; palatal + ("\\lc" ?ʟ) ; velar + + ;; implosives + ("\\b^" ?ɓ) ; bilabial + ("\\d^" ?ɗ) ; alveolar + ("\\j^" ?ʄ) ; palatal + ("\\g^" ?ɠ) ; velar + ("\\G^" ?ʛ) ; uvular + + ;; clicks + ("\\O." ?ʘ) ; bilabial + ("\\|1" ?ǀ) ; dental + ("\\|2" ?ǁ) ; alv. lateral + ("\\|-" ?ǂ) ; postalveolar + + ;; other + ("\\l~" ?ɫ) ; velarized l + ("\\hj" ?ɧ) ; post-alveolar & velar fricative + + ;; vowels + ("\\i-" ?ɨ) + ("\\u-" ?ʉ) + + ("\\mt" ?ɯ) + + ("\\ic" ?ɪ) + ("\\yc" ?ʏ) + + ("\\hs" ?ʊ) + + ("\\o/" ?ø) + ("\\e-" ?ɘ) + ("\\o-" ?ɵ) + ("\\rh" ?ɤ) + + ("\\sw" ?ə) + + ("\\ef" ?ɛ) + ("\\oe" ?œ) + ("\\er" ?ɜ) + ("\\kb" ?ɞ) + ("\\vt" ?ʌ) + ("\\ct" ?ɔ) + + ("\\ae" ?æ) + ("\\at" ?ɐ) + + ("\\Oe" ?ɶ) + ("\\as" ?ɑ) + ("\\ab" ?ɒ) + + ("\\sr" ?ɚ) + + ;; diacritics + ("\\:f" ?ː) ; phonetic length sign + ("\\'1" ?ˈ) ; primary stress + ("\\'2" ?ˌ) ; secondary stress + ("\\cn" #x031A) ; t̚ unreleased plosive + ("\\rh" #x02DE) ; ɜ˞ rhotacized vowel + + ("\\|v" #x0329) ; n̩ syllabic consonant + ("\\0v" #x0325) ; b̥ voiceless + ("\\Tv" #x031E) ; o̞ lowered + ("\\T^" #x031D ) ; o̝ raised + ("\\T(" #x0318) ; o̘ advanced tongue root + ("\\T)" #x0319) ; o̙ retracted tongue root + ("\\-v" #x0331) ; e̱ backed + ("\\+v" #x031F) ; o̟ fronted + ("\\:v" #x0324) ; o̤ breathy voice + ("\\~v" #x0330) ; o̰ creaky voice + ("\\Nv" #x032A) ; d̪ dental (as opposed to alveolar) + ("\\Uv" #x033A) ; d̺ apical + ("\\Dv" #x033B) ; d̻ laminal + ("\\nv" #x032F) ; u̯ nonsyllabic + ("\\e3v" #x0339) ; e̹ slightly rounded + ("\\cv" #x031C) ; u̜ slightly unrounded + + ("\\0^" #x030A) ; ɣ̊ voiceless + ("\\'^" #x0301) ; high tone + ("\\`^" #x0300) ; low tone + ("\\-^" #x0304) ; mid tone + ("\\~^" #x0303) ; nasalized + ("\\v^" #x030C) ; rising tone + ("\\^^" #x0302) ; falling tone + ("\\:^" #x0308) ; centralized + ("\\N^" #x0306) ; short + ("\\li" #x0361) ; k͡p simultaneous articulation or single segment + ) + +;; Local Variables: +;; coding: utf-8 +;; End: + +;;; ipa-praat.el ends here ------------------------------------------------------------ revno: 104435 committer: Paul Eggert branch nick: trunk timestamp: Mon 2011-05-30 09:09:29 -0700 message: * alloc.c (lisp_align_malloc): Omit unnecessary val==NULL tests. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-05-30 05:39:59 +0000 +++ src/ChangeLog 2011-05-30 16:09:29 +0000 @@ -1,5 +1,7 @@ 2011-05-30 Paul Eggert + * alloc.c (lisp_align_malloc): Omit unnecessary val==NULL tests. + * eval.c (Qdebug): Now static. * lisp.h (Qdebug): Remove decl. This reverts a part of the 2011-04-26 change (bzr 104015) that inadvertently undid part of === modified file 'src/alloc.c' --- src/alloc.c 2011-05-23 00:31:35 +0000 +++ src/alloc.c 2011-05-30 16:09:29 +0000 @@ -993,13 +993,11 @@ free_ablock = free_ablock->x.next_free; #if GC_MARK_STACK && !defined GC_MALLOC_CHECK - if (val && type != MEM_TYPE_NON_LISP) + if (type != MEM_TYPE_NON_LISP) mem_insert (val, (char *) val + nbytes, type); #endif MALLOC_UNBLOCK_INPUT; - if (!val && nbytes) - memory_full (); eassert (0 == ((uintptr_t) val) % BLOCK_ALIGN); return val; ------------------------------------------------------------ revno: 104434 committer: Leo Liu branch nick: trunk timestamp: Mon 2011-05-30 20:23:56 +0800 message: Decode all incoming messages in rcirc.el Also allow automatic coding system detection if rcirc-decode-coding-system is nil. See discussion in http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8744 diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-30 12:04:44 +0000 +++ lisp/ChangeLog 2011-05-30 12:23:56 +0000 @@ -1,6 +1,9 @@ 2011-05-30 Leo Liu * net/rcirc.el (rcirc-debug-buffer): Use visible buffer name. + (rcirc-print): Decode all incoming messages (bug#8744). + (rcirc-decode-coding-system): Allow value nil for automatic coding + system detection. 2011-05-29 Chong Yidong === modified file 'lisp/net/rcirc.el' --- lisp/net/rcirc.el 2011-05-30 12:04:44 +0000 +++ lisp/net/rcirc.el 2011-05-30 12:23:56 +0000 @@ -314,9 +314,11 @@ :type 'boolean :group 'rcirc) -(defcustom rcirc-decode-coding-system 'utf-8 - "Coding system used to decode incoming irc messages." +(defcustom rcirc-decode-coding-system nil + "Coding system used to decode incoming irc messages. +If nil automatically detect the coding system." :type 'coding-system + :version "24.1" :group 'rcirc) (defcustom rcirc-encode-coding-system 'utf-8 @@ -1480,9 +1482,9 @@ (old-point (point-marker)) (fill-start (marker-position rcirc-prompt-start-marker))) + (setq text (decode-coding-string text (or rcirc-decode-coding-system + (detect-coding-string text t)))) (unless (string= sender (rcirc-nick process)) - ;; only decode text from other senders, not ours - (setq text (decode-coding-string text rcirc-decode-coding-system)) ;; mark the line with overlay arrow (unless (or (marker-position overlay-arrow-position) (get-buffer-window (current-buffer)) ------------------------------------------------------------ revno: 104433 committer: Leo Liu branch nick: trunk timestamp: Mon 2011-05-30 20:04:44 +0800 message: Use a visible buffer name for rcirc-debug-buffer diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-29 21:35:35 +0000 +++ lisp/ChangeLog 2011-05-30 12:04:44 +0000 @@ -1,3 +1,7 @@ +2011-05-30 Leo Liu + + * net/rcirc.el (rcirc-debug-buffer): Use visible buffer name. + 2011-05-29 Chong Yidong * image.el (image-animate-max-time): Allow nil and t values. === modified file 'lisp/net/rcirc.el' --- lisp/net/rcirc.el 2011-05-29 05:42:00 +0000 +++ lisp/net/rcirc.el 2011-05-30 12:04:44 +0000 @@ -616,7 +616,7 @@ (setq header-line-format (format "%f" (- (rcirc-float-time) (string-to-number message)))))) -(defvar rcirc-debug-buffer " *rcirc debug*") +(defvar rcirc-debug-buffer "*rcirc debug*") (defvar rcirc-debug-flag nil "If non-nil, write information to `rcirc-debug-buffer'.") (defun rcirc-debug (process text) ------------------------------------------------------------ revno: 104432 committer: Glenn Morris branch nick: trunk timestamp: Mon 2011-05-30 06:18:40 -0400 message: Auto-commit of generated files. diff: === modified file 'autogen/Makefile.in' --- autogen/Makefile.in 2011-05-24 17:24:15 +0000 +++ autogen/Makefile.in 2011-05-30 10:18:40 +0000 @@ -24,7 +24,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=. --makefile-name=gnulib.mk --no-libtool --macro-prefix=gl --no-vc-files careadlinkat crypto/md5 crypto/sha1 dtoastr filemode getloadavg getopt-gnu ignore-value intprops lstat mktime readlink socklen stdarg stdio strftime strtoumax symlink sys_stat +# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=. --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files careadlinkat crypto/md5 crypto/sha1 dtoastr filemode getloadavg getopt-gnu ignore-value intprops lstat mktime readlink socklen stdarg stdio strftime strtoumax symlink sys_stat VPATH = @srcdir@ pkgdatadir = $(datadir)/@PACKAGE@ @@ -1070,7 +1070,8 @@ getopt.h: getopt.in.h $(top_builddir)/config.status $(ARG_NONNULL_H) $(AM_V_GEN)rm -f $@-t $@ && \ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ - sed -e 's|@''HAVE_GETOPT_H''@|$(HAVE_GETOPT_H)|g' \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''HAVE_GETOPT_H''@|$(HAVE_GETOPT_H)|g' \ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ @@ -1118,7 +1119,8 @@ @GL_GENERATE_STDARG_H_TRUE@stdarg.h: stdarg.in.h $(top_builddir)/config.status @GL_GENERATE_STDARG_H_TRUE@ $(AM_V_GEN)rm -f $@-t $@ && \ @GL_GENERATE_STDARG_H_TRUE@ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ -@GL_GENERATE_STDARG_H_TRUE@ sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ +@GL_GENERATE_STDARG_H_TRUE@ sed -e 's|@''GUARD_PREFIX''@|GL|g' \ +@GL_GENERATE_STDARG_H_TRUE@ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ @GL_GENERATE_STDARG_H_TRUE@ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ @GL_GENERATE_STDARG_H_TRUE@ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ @GL_GENERATE_STDARG_H_TRUE@ -e 's|@''NEXT_STDARG_H''@|$(NEXT_STDARG_H)|g' \ @@ -1144,7 +1146,8 @@ @GL_GENERATE_STDDEF_H_TRUE@stddef.h: stddef.in.h $(top_builddir)/config.status @GL_GENERATE_STDDEF_H_TRUE@ $(AM_V_GEN)rm -f $@-t $@ && \ @GL_GENERATE_STDDEF_H_TRUE@ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ -@GL_GENERATE_STDDEF_H_TRUE@ sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ +@GL_GENERATE_STDDEF_H_TRUE@ sed -e 's|@''GUARD_PREFIX''@|GL|g' \ +@GL_GENERATE_STDDEF_H_TRUE@ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ @GL_GENERATE_STDDEF_H_TRUE@ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ @GL_GENERATE_STDDEF_H_TRUE@ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ @GL_GENERATE_STDDEF_H_TRUE@ -e 's|@''NEXT_STDDEF_H''@|$(NEXT_STDDEF_H)|g' \ @@ -1161,7 +1164,8 @@ @GL_GENERATE_STDINT_H_TRUE@stdint.h: stdint.in.h $(top_builddir)/config.status @GL_GENERATE_STDINT_H_TRUE@ $(AM_V_GEN)rm -f $@-t $@ && \ @GL_GENERATE_STDINT_H_TRUE@ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ -@GL_GENERATE_STDINT_H_TRUE@ sed -e 's/@''HAVE_STDINT_H''@/$(HAVE_STDINT_H)/g' \ +@GL_GENERATE_STDINT_H_TRUE@ sed -e 's|@''GUARD_PREFIX''@|GL|g' \ +@GL_GENERATE_STDINT_H_TRUE@ -e 's/@''HAVE_STDINT_H''@/$(HAVE_STDINT_H)/g' \ @GL_GENERATE_STDINT_H_TRUE@ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ @GL_GENERATE_STDINT_H_TRUE@ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ @GL_GENERATE_STDINT_H_TRUE@ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ @@ -1198,7 +1202,8 @@ stdio.h: stdio.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) $(AM_V_GEN)rm -f $@-t $@ && \ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ - sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ -e 's|@''NEXT_STDIO_H''@|$(NEXT_STDIO_H)|g' \ @@ -1312,7 +1317,8 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) $(AM_V_GEN)rm -f $@-t $@ && \ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ - sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ -e 's|@''NEXT_STDLIB_H''@|$(NEXT_STDLIB_H)|g' \ @@ -1393,7 +1399,8 @@ $(AM_V_at)$(MKDIR_P) sys $(AM_V_GEN)rm -f $@-t $@ && \ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ - sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ -e 's|@''NEXT_SYS_STAT_H''@|$(NEXT_SYS_STAT_H)|g' \ @@ -1441,7 +1448,8 @@ time.h: time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) $(AM_V_GEN)rm -f $@-t $@ && \ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ - sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ -e 's|@''NEXT_TIME_H''@|$(NEXT_TIME_H)|g' \ @@ -1473,7 +1481,8 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) $(AM_V_GEN)rm -f $@-t $@ && \ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ - sed -e 's|@''HAVE_UNISTD_H''@|$(HAVE_UNISTD_H)|g' \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''HAVE_UNISTD_H''@|$(HAVE_UNISTD_H)|g' \ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ === modified file 'autogen/configure' --- autogen/configure 2011-05-25 10:19:20 +0000 +++ autogen/configure 2011-05-30 10:18:40 +0000 @@ -16710,10 +16710,6 @@ # Persuade glibc to declare getloadavg(). -# Make sure getloadavg.c is where it belongs, at configure-time. -test -f "$srcdir/$gl_source_base/getloadavg.c" || - as_fn_error "$srcdir/$gl_source_base/getloadavg.c is missing" "$LINENO" 5 - gl_save_LIBS=$LIBS # getloadvg is present in libc on glibc >= 2.2, MacOS X, FreeBSD >= 2.0, ------------------------------------------------------------ revno: 104431 committer: Paul Eggert branch nick: trunk timestamp: Sun 2011-05-29 22:39:59 -0700 message: * eval.c (Qdebug): Now static. * lisp.h (Qdebug): Remove decl. This reverts a part of the 2011-04-26 change (bzr 104015) that inadvertently undid part of the 2011-04-14 change (bzr 103913). diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-05-29 18:17:28 +0000 +++ src/ChangeLog 2011-05-30 05:39:59 +0000 @@ -1,3 +1,10 @@ +2011-05-30 Paul Eggert + + * eval.c (Qdebug): Now static. + * lisp.h (Qdebug): Remove decl. This reverts a part of the + 2011-04-26 change (bzr 104015) that inadvertently undid part of + the 2011-04-14 change (bzr 103913). + 2011-05-29 Chong Yidong * image.c: Various fixes to ImageMagick code comments. === modified file 'src/eval.c' --- src/eval.c 2011-05-04 07:19:21 +0000 +++ src/eval.c 2011-05-30 05:39:59 +0000 @@ -88,7 +88,7 @@ static Lisp_Object Qdeclare; Lisp_Object Qinternal_interpreter_environment, Qclosure; -Lisp_Object Qdebug; +static Lisp_Object Qdebug; /* This holds either the symbol `run-hooks' or nil. It is nil at an early stage of startup, and when Emacs === modified file 'src/lisp.h' --- src/lisp.h 2011-05-22 07:12:24 +0000 +++ src/lisp.h 2011-05-30 05:39:59 +0000 @@ -2836,7 +2836,7 @@ /* Defined in eval.c. */ extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qdefun, Qmacro; -extern Lisp_Object Qinhibit_quit, Qclosure, Qdebug; +extern Lisp_Object Qinhibit_quit, Qclosure; extern Lisp_Object Qand_rest; extern Lisp_Object Vautoload_queue; extern Lisp_Object Vsignaling_function; ------------------------------------------------------------ revno: 104430 author: Gnus developers committer: Katsumi Yamaoka branch nick: trunk timestamp: Sun 2011-05-29 23:28:45 +0000 message: shr.el (shr-urlify): Use shr-add-font to make underlines be less ugly at the end of lines. smiley.el (gnus-smiley-file-types): Add gif as supported file type. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2011-05-27 00:55:07 +0000 +++ lisp/gnus/ChangeLog 2011-05-29 23:28:45 +0000 @@ -1,3 +1,12 @@ +2011-05-29 Lars Magne Ingebrigtsen + + * shr.el (shr-urlify): Use shr-add-font to make underlines be less ugly + at the end of lines. + +2011-05-29 Julien Danjou + + * smiley.el (gnus-smiley-file-types): Add gif as supported file type. + 2011-05-27 Glenn Morris * gnus-group.el (gnus-bug-group-download-format-alist): === modified file 'lisp/gnus/shr.el' --- lisp/gnus/shr.el 2011-05-16 09:33:14 +0000 +++ lisp/gnus/shr.el 2011-05-29 23:28:45 +0000 @@ -601,7 +601,7 @@ :help-echo (if title (format "%s (%s)" url title) url) :keymap shr-map url) - (put-text-property start (point) 'face 'shr-link) + (shr-add-font start (point) 'shr-link) (put-text-property start (point) 'shr-url url)) (defun shr-encode-url (url) === modified file 'lisp/gnus/smiley.el' --- lisp/gnus/smiley.el 2011-01-25 04:08:28 +0000 +++ lisp/gnus/smiley.el 2011-05-29 23:28:45 +0000 @@ -133,9 +133,11 @@ (let ((types (list "pbm"))) (when (gnus-image-type-available-p 'xpm) (push "xpm" types)) + (when (gnus-image-type-available-p 'gif) + (push "gif" types)) types) "*List of suffixes on smiley file names to try." - :version "22.1" + :version "24.1" :type '(repeat string) :group 'smiley) ------------------------------------------------------------ revno: 104429 [merge] committer: Glenn Morris branch nick: trunk timestamp: Sun 2011-05-29 15:41:06 -0700 message: Merge from emacs-23; up to r100589. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2011-05-29 19:00:00 +0000 +++ doc/lispref/ChangeLog 2011-05-29 22:41:06 +0000 @@ -1,5 +1,22 @@ 2011-05-29 Chong Yidong + * help.texi (Accessing Documentation): + * display.texi (Pixel Specification): + * processes.texi (Serial Ports, Serial Ports): + * nonascii.texi (Character Properties, Default Coding Systems): + * text.texi (Changing Properties, Special Properties): + * windows.texi (Window Start and End): + * modes.texi (SMIE Indentation Example, SMIE Tricks): + * keymaps.texi (Searching Keymaps, Tool Bar): + * minibuf.texi (Basic Completion): + * compile.texi (Eval During Compile): + * strings.texi (Formatting Strings): Tweaks to avoid overflowing + 7x9 paper in printed manual. + + * lists.texi (Sets And Lists): Fix misplaced text. + +2011-05-29 Chong Yidong + * keymaps.texi (Remapping Commands): Emphasize that the keymap needs to be active (Bug#8350). === modified file 'doc/lispref/compile.texi' --- doc/lispref/compile.texi 2011-01-25 04:08:28 +0000 +++ doc/lispref/compile.texi 2011-05-29 22:41:06 +0000 @@ -445,7 +445,7 @@ @lisp (eval-when-compile - (require 'my-macro-package)) ;; only macros needed from this + (require 'my-macro-package)) @end lisp The same sort of thing goes for macros and @code{defsubst} functions === modified file 'doc/lispref/display.texi' --- doc/lispref/display.texi 2011-05-19 06:54:27 +0000 +++ doc/lispref/display.texi 2011-05-29 22:41:06 +0000 @@ -1441,9 +1441,9 @@ Attributes}. @item -A cons cell, either of the form @code{(foreground-color . @var{color-name})} or -@code{(background-color . @var{color-name})}. These elements specify -just the foreground color or just the background color. +A cons cell, either of the form @code{(fg-color . @var{color-name})} +or @code{(bg-color . @var{color-name})}. These elements specify just +the foreground color or just the background color. @code{(foreground-color . @var{color-name})} has the same effect as @code{(:foreground @var{color-name})}; likewise for the background. @@ -3821,9 +3821,10 @@ and height of the current face. An image specification @code{image} corresponds to the width or height of the image. - The @code{left-fringe}, @code{right-fringe}, @code{left-margin}, -@code{right-margin}, @code{scroll-bar}, and @code{text} elements -specify to the width of the corresponding area of the window. + The elements @code{left-fringe}, @code{right-fringe}, +@code{left-margin}, @code{right-margin}, @code{scroll-bar}, and +@code{text} specify to the width of the corresponding area of the +window. The @code{left}, @code{center}, and @code{right} positions can be used with @code{:align-to} to specify a position relative to the left @@ -4652,16 +4653,14 @@ found, don't signal an error. Instead, return a list of directories as before, except that @code{nil} appears in place of the image directory. -Here is an example that uses a common idiom to provide compatibility -with versions of Emacs that lack the variable @code{image-load-path}: +Here is an example of using @code{image-load-path-for-library}: @example (defvar image-load-path) ; shush compiler (let* ((load-path (image-load-path-for-library - "mh-e" "mh-logo.xpm")) + "mh-e" "mh-logo.xpm")) (image-load-path (cons (car load-path) - (when (boundp 'image-load-path) - image-load-path)))) + image-load-path))) (mh-tool-bar-folder-buttons-init)) @end example @end defun @@ -5399,8 +5398,10 @@ (aref colorcomp-data 2))) (samp " (sample text) ")) (insert "Color\t: " - (propertize samp 'face `(foreground-color . ,cstr)) - (propertize samp 'face `(background-color . ,cstr)) + (propertize samp 'face + `(foreground-color . ,cstr)) + (propertize samp 'face + `(background-color . ,cstr)) "\n")))) (defun colorcomp (color) === modified file 'doc/lispref/elisp.texi' --- doc/lispref/elisp.texi 2011-05-12 07:07:06 +0000 +++ doc/lispref/elisp.texi 2011-05-29 22:41:06 +0000 @@ -14,7 +14,7 @@ @c in general, keep the following line commented out, unless doing a @c copy of this manual that will be published. The manual should go @c onto the distribution in the full, 8.5 x 11" size. -@c set smallbook +@c @smallbook @ifset smallbook @smallbook === modified file 'doc/lispref/help.texi' --- doc/lispref/help.texi 2011-01-25 04:08:28 +0000 +++ doc/lispref/help.texi 2011-05-29 22:41:06 +0000 @@ -138,9 +138,9 @@ @end defun @defun documentation function &optional verbatim -This function returns the documentation string of @var{function}. -@code{documentation} handles macros, named keyboard macros, and -special forms, as well as ordinary functions. +This function returns the documentation string of @var{function}. It +handles macros, named keyboard macros, and special forms, as well as +ordinary functions. If @var{function} is a symbol, this function first looks for the @code{function-documentation} property of that symbol; if that has a === modified file 'doc/lispref/keymaps.texi' --- doc/lispref/keymaps.texi 2011-05-29 19:00:00 +0000 +++ doc/lispref/keymaps.texi 2011-05-29 22:41:06 +0000 @@ -718,17 +718,18 @@ them: @lisp -(or (if overriding-terminal-local-map - (@var{find-in} overriding-terminal-local-map) - (if overriding-local-map - (@var{find-in} overriding-local-map) - (or (@var{find-in} (get-char-property (point) 'keymap)) - (@var{find-in-any} emulation-mode-map-alists) - (@var{find-in-any} minor-mode-overriding-map-alist) - (@var{find-in-any} minor-mode-map-alist) - (if (get-text-property (point) 'local-map) - (@var{find-in} (get-char-property (point) 'local-map)) - (@var{find-in} (current-local-map)))))) +(or (cond + (overriding-terminal-local-map + (@var{find-in} overriding-terminal-local-map)) + (overriding-local-map + (@var{find-in} overriding-local-map)) + (or (@var{find-in} (get-char-property (point) 'keymap)) + (@var{find-in-any} emulation-mode-map-alists) + (@var{find-in-any} minor-mode-overriding-map-alist) + (@var{find-in-any} minor-mode-map-alist) + (if (get-text-property (point) 'local-map) + (@var{find-in} (get-char-property (point) 'local-map)) + (@var{find-in} (current-local-map))))) (@var{find-in} (current-global-map))) @end lisp @@ -2635,8 +2636,8 @@ By default, the global map binds @code{[tool-bar]} as follows: @example (global-set-key [tool-bar] - '(menu-item "tool bar" ignore - :filter (lambda (ignore) tool-bar-map))) + '(menu-item "tool bar" ignore + :filter (lambda (ignore) tool-bar-map))) @end example @noindent Thus the tool bar map is derived dynamically from the value of variable === modified file 'doc/lispref/lists.texi' --- doc/lispref/lists.texi 2011-05-19 07:23:18 +0000 +++ doc/lispref/lists.texi 2011-05-29 22:41:06 +0000 @@ -1355,10 +1355,10 @@ (delq '(4) sample-list) @result{} (a c (4)) @end group +@end example If you want to delete elements that are @code{equal} to a given value, use @code{delete} (see below). -@end example @defun remq object list This function returns a copy of @var{list}, with all elements removed === modified file 'doc/lispref/minibuf.texi' --- doc/lispref/minibuf.texi 2011-05-28 19:58:43 +0000 +++ doc/lispref/minibuf.texi 2011-05-29 22:41:06 +0000 @@ -837,12 +837,13 @@ @code{risky-local-variable} property. @xref{File Local Variables}. @defvar completion-ignore-case -If the value of this variable is non-@code{nil}, Emacs does not -consider case significant in completion. Note, however, that this -variable is overridden by @code{read-file-name-completion-ignore-case} -within @code{read-file-name} (@pxref{Reading File Names}), and by -@code{read-buffer-completion-ignore-case} within @code{read-buffer} -(@pxref{High-Level Completion}). +If the value of this variable is non-@code{nil}, case is not +considered significant in completion. Within @code{read-file-name}, +this variable is overridden by +@code{read-file-name-completion-ignore-case} (@pxref{Reading File +Names}); within @code{read-buffer}, it is overridden by +@code{read-buffer-completion-ignore-case} (@pxref{High-Level +Completion}). @end defvar @defvar completion-regexp-list === modified file 'doc/lispref/modes.texi' --- doc/lispref/modes.texi 2011-05-27 01:43:15 +0000 +++ doc/lispref/modes.texi 2011-05-29 22:41:06 +0000 @@ -1046,8 +1046,8 @@ @end group @group ;; @r{These four lines are absent from the current version} - ;; @r{not because this is done some other way, but rather} - ;; @r{because nowadays Text mode uses the normal definition of paragraphs.} + ;; @r{not because this is done some other way, but because} + ;; @r{nowadays Text mode uses the normal definition of paragraphs.} (set (make-local-variable 'paragraph-start) (concat "[ \t]*$\\|" page-delimiter)) (set (make-local-variable 'paragraph-separate) paragraph-start) @@ -1139,12 +1139,15 @@ @smallexample @group - (set (make-local-variable 'paragraph-start) (concat page-delimiter "\\|$" )) - (set (make-local-variable 'paragraph-separate) paragraph-start) + (set (make-local-variable 'paragraph-start) + (concat page-delimiter "\\|$" )) + (set (make-local-variable 'paragraph-separate) + paragraph-start) @dots{} @end group @group - (set (make-local-variable 'comment-indent-function) 'lisp-comment-indent)) + (set (make-local-variable 'comment-indent-function) + 'lisp-comment-indent)) @dots{} @end group @end smallexample @@ -3619,7 +3622,9 @@ (inst ("IF" exp "THEN" insts "ELSE" insts "END") ("CASE" exp "OF" cases "END") ...) - (cases (cases "|" cases) (caselabel ":" insts) ("ELSE" insts)) + (cases (cases "|" cases) + (caselabel ":" insts) + ("ELSE" insts)) ... @end example @@ -3894,9 +3899,10 @@ rule: @example ((equal token "if") - (and (not (smie-rule-bolp)) (smie-rule-prev-p "else") + (and (not (smie-rule-bolp)) + (smie-rule-prev-p "else") (save-excursion - (sample-smie-backward-token) ;Jump before the "else". + (sample-smie-backward-token) (cons 'column (current-column))))) @end example === modified file 'doc/lispref/nonascii.texi' --- doc/lispref/nonascii.texi 2011-05-19 06:54:27 +0000 +++ doc/lispref/nonascii.texi 2011-05-29 22:41:06 +0000 @@ -374,18 +374,18 @@ @table @code @item name -This property corresponds to the Unicode @code{Name} property. The -value is a string consisting of upper-case Latin letters A to Z, -digits, spaces, and hyphen @samp{-} characters. +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. @cindex unicode general category @item general-category -This property corresponds to the Unicode @code{General_Category} -property. The value is a symbol whose name is a 2-letter abbreviation -of the character's classification. +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. @item canonical-combining-class -Corresponds to the Unicode @code{Canonical_Combining_Class} property. +Corresponds to the @code{Canonical_Combining_Class} Unicode property. The value is an integer number. @item bidi-class @@ -466,15 +466,18 @@ @result{} Nd @end group @group -(get-char-code-property ?\u2084 'digit-value) ; subscript 4 +;; subscript 4 +(get-char-code-property ?\u2084 'digit-value) @result{} 4 @end group @group -(get-char-code-property ?\u2155 'numeric-value) ; one fifth +;; one fifth +(get-char-code-property ?\u2155 'numeric-value) @result{} 0.2 @end group @group -(get-char-code-property ?\u2163 'numeric-value) ; Roman IV +;; Roman IV +(get-char-code-property ?\u2163 'numeric-value) @result{} 4 @end group @end example @@ -1449,11 +1452,11 @@ @var{encoding-system} is the coding system for encoding (in case @var{operation} does encoding). -The argument @var{operation} is a symbol, one of @code{write-region}, -@code{start-process}, @code{call-process}, @code{call-process-region}, -@code{insert-file-contents}, or @code{open-network-stream}. These are -the names of the Emacs I/O primitives that can do character code and -eol conversion. +The argument @var{operation} is a symbol; it should be one of +@code{write-region}, @code{start-process}, @code{call-process}, +@code{call-process-region}, @code{insert-file-contents}, or +@code{open-network-stream}. These are the names of the Emacs I/O +primitives that can do character code and eol conversion. The remaining arguments should be the same arguments that might be given to the corresponding I/O primitive. Depending on the primitive, one === modified file 'doc/lispref/processes.texi' --- doc/lispref/processes.texi 2011-05-01 00:04:17 +0000 +++ doc/lispref/processes.texi 2011-05-29 22:41:06 +0000 @@ -1794,9 +1794,9 @@ The number of threads in the process. @item start -The time the process was started, in the @w{@code{(@var{high} -@var{low} @var{microsec})}} format used by @code{current-time} and -@code{file-attributes}. +The time when the process was started, in the same +@w{@code{(@var{high} @var{low} @var{microsec})}} format used by +@code{current-time} and @code{file-attributes}. @item etime The time elapsed since the process started, in the @w{@code{(@var{high} @@ -2482,25 +2482,17 @@ @itemx :parity @itemx :stopbits @itemx :flowcontrol -These arguments are handled by @code{serial-process-configure}, which -is called by @code{make-serial-process}. +These are handled by @code{serial-process-configure}, which is called +by @code{make-serial-process}. @end table The original argument list, possibly modified by later configuration, is available via the function @code{process-contact}. -Examples: +Here is an example: @example (make-serial-process :port "/dev/ttyS0" :speed 9600) - -(make-serial-process :port "COM1" :speed 115200 :stopbits 2) - -(make-serial-process :port "\\\\.\\COM13" :speed 1200 - :bytesize 7 :parity 'odd) - -(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" - :speed nil) @end example @end defun @@ -2560,19 +2552,9 @@ flow control. @end table -@code{serial-process-configure} is called by @code{make-serial-process} for the -initial configuration of the serial port. - -Examples: - -@example -(serial-process-configure :process "/dev/ttyS0" :speed 1200) - -(serial-process-configure :buffer "COM1" :stopbits 1 - :parity 'odd :flowcontrol 'hw) - -(serial-process-configure :port "\\\\.\\COM13" :bytesize 7) -@end example +@code{serial-process-configure} is called by +@code{make-serial-process} for the initial configuration of the serial +port. @end defun @node Byte Packing === modified file 'doc/lispref/strings.texi' --- doc/lispref/strings.texi 2011-03-19 18:49:31 +0000 +++ doc/lispref/strings.texi 2011-05-29 22:41:06 +0000 @@ -828,12 +828,12 @@ @example @group -(format "The word `%7s' actually has %d letters in it." +(format "The word `%7s' has %d letters in it." "foo" (length "foo")) - @result{} "The word ` foo' actually has 3 letters in it." -(format "The word `%7s' actually has %d letters in it." + @result{} "The word ` foo' has 3 letters in it." +(format "The word `%7s' has %d letters in it." "specification" (length "specification")) - @result{} "The word `specification' actually has 13 letters in it." + @result{} "The word `specification' has 13 letters in it." @end group @end example === modified file 'doc/lispref/text.texi' --- doc/lispref/text.texi 2011-05-19 06:54:27 +0000 +++ doc/lispref/text.texi 2011-05-29 22:41:06 +0000 @@ -2806,9 +2806,9 @@ @end smallexample @end defun - See also the function @code{buffer-substring-no-properties} -(@pxref{Buffer Contents}) which copies text from the buffer -but does not copy its properties. + @xref{Buffer Contents}, for the function +@code{buffer-substring-no-properties}, which copies text from the +buffer but does not copy its properties. @node Property Search @subsection Text Property Search Functions @@ -2992,13 +2992,6 @@ attribute. With this feature, you do not need to create a face each time you want to specify a particular attribute for certain text. @xref{Face Attributes}. - -@item -A cons cell with the form @code{(foreground-color . @var{color-name})} -or @code{(background-color . @var{color-name})}. These are old, -deprecated equivalents for @code{(:foreground @var{color-name})} and -@code{(:background @var{color-name})}. Please convert code that uses -them. @end itemize It works to use the latter two forms directly as the value === modified file 'doc/lispref/tips.texi' --- doc/lispref/tips.texi 2011-05-28 19:05:36 +0000 +++ doc/lispref/tips.texi 2011-05-29 22:41:06 +0000 @@ -249,7 +249,8 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with this program. If not, see +;; . @end smallexample If you have signed papers to assign the copyright to the Foundation, === modified file 'doc/lispref/windows.texi' --- doc/lispref/windows.texi 2011-05-19 06:54:27 +0000 +++ doc/lispref/windows.texi 2011-05-29 22:41:06 +0000 @@ -1462,10 +1462,10 @@ selected window. If @var{position} is @code{t}, that means to check the last visible position in @var{window}. -The @code{pos-visible-in-window-p} function considers only vertical -scrolling. If @var{position} is out of view only because @var{window} -has been scrolled horizontally, @code{pos-visible-in-window-p} returns -non-@code{nil} anyway. @xref{Horizontal Scrolling}. +This function considers only vertical scrolling. If @var{position} is +out of view only because @var{window} has been scrolled horizontally, +@code{pos-visible-in-window-p} returns non-@code{nil} anyway. +@xref{Horizontal Scrolling}. If @var{position} is visible, @code{pos-visible-in-window-p} returns @code{t} if @var{partially} is @code{nil}; if @var{partially} is ------------------------------------------------------------ revno: 104428 [merge] committer: Paul Eggert branch nick: trunk timestamp: Sun 2011-05-29 14:53:53 -0700 message: Merge: Adjust to recent gnulib change for @GUARD_PREFIX@. diff: === modified file 'ChangeLog' --- ChangeLog 2011-05-27 16:58:43 +0000 +++ ChangeLog 2011-05-29 21:52:18 +0000 @@ -1,3 +1,10 @@ +2011-05-29 Paul Eggert + + Adjust to recent gnulib change for @GUARD_PREFIX@. + * lib/makefile.w32-in (getopt_h): Substitute @GUARD_PREFIX@, too. + All uses of _GL_ for guard prefixes in lib/*.h replaced with + _@GUARD_PREFIX@_. + 2011-05-27 Paul Eggert * doc/misc/texinfo.tex, lib/getopt.c, lib/intprops.h: Merge from gnulib. === modified file 'lib/getopt.in.h' --- lib/getopt.in.h 2011-02-07 01:01:26 +0000 +++ lib/getopt.in.h 2011-05-29 21:52:18 +0000 @@ -16,7 +16,7 @@ You should have received a copy of the GNU General Public License along with this program. If not, see . */ -#ifndef _GL_GETOPT_H +#ifndef _@GUARD_PREFIX@_GETOPT_H #if __GNUC__ >= 3 @PRAGMA_SYSTEM_HEADER@ @@ -32,10 +32,10 @@ # undef _GL_SYSTEM_GETOPT #endif -#ifndef _GL_GETOPT_H +#ifndef _@GUARD_PREFIX@_GETOPT_H #ifndef __need_getopt -# define _GL_GETOPT_H 1 +# define _@GUARD_PREFIX@_GETOPT_H 1 #endif /* Standalone applications should #define __GETOPT_PREFIX to an @@ -249,5 +249,5 @@ /* Make sure we later can get all the definitions and declarations. */ #undef __need_getopt -#endif /* getopt.h */ -#endif /* getopt.h */ +#endif /* _@GUARD_PREFIX@_GETOPT_H */ +#endif /* _@GUARD_PREFIX@_GETOPT_H */ === modified file 'lib/gnulib.mk' --- lib/gnulib.mk 2011-05-24 08:12:52 +0000 +++ lib/gnulib.mk 2011-05-29 21:52:18 +0000 @@ -9,7 +9,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=. --makefile-name=gnulib.mk --no-libtool --macro-prefix=gl --no-vc-files careadlinkat crypto/md5 crypto/sha1 dtoastr filemode getloadavg getopt-gnu ignore-value intprops lstat mktime readlink socklen stdarg stdio strftime strtoumax symlink sys_stat +# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=. --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files careadlinkat crypto/md5 crypto/sha1 dtoastr filemode getloadavg getopt-gnu ignore-value intprops lstat mktime readlink socklen stdarg stdio strftime strtoumax symlink sys_stat MOSTLYCLEANFILES += core *.stackdump @@ -149,7 +149,8 @@ getopt.h: getopt.in.h $(top_builddir)/config.status $(ARG_NONNULL_H) $(AM_V_GEN)rm -f $@-t $@ && \ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ - sed -e 's|@''HAVE_GETOPT_H''@|$(HAVE_GETOPT_H)|g' \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''HAVE_GETOPT_H''@|$(HAVE_GETOPT_H)|g' \ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ @@ -278,7 +279,8 @@ stdarg.h: stdarg.in.h $(top_builddir)/config.status $(AM_V_GEN)rm -f $@-t $@ && \ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ - sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ -e 's|@''NEXT_STDARG_H''@|$(NEXT_STDARG_H)|g' \ @@ -328,7 +330,8 @@ stddef.h: stddef.in.h $(top_builddir)/config.status $(AM_V_GEN)rm -f $@-t $@ && \ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ - sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ -e 's|@''NEXT_STDDEF_H''@|$(NEXT_STDDEF_H)|g' \ @@ -357,7 +360,8 @@ stdint.h: stdint.in.h $(top_builddir)/config.status $(AM_V_GEN)rm -f $@-t $@ && \ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ - sed -e 's/@''HAVE_STDINT_H''@/$(HAVE_STDINT_H)/g' \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's/@''HAVE_STDINT_H''@/$(HAVE_STDINT_H)/g' \ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ @@ -405,7 +409,8 @@ stdio.h: stdio.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) $(AM_V_GEN)rm -f $@-t $@ && \ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ - sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ -e 's|@''NEXT_STDIO_H''@|$(NEXT_STDIO_H)|g' \ @@ -528,7 +533,8 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) $(AM_V_GEN)rm -f $@-t $@ && \ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ - sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ -e 's|@''NEXT_STDLIB_H''@|$(NEXT_STDLIB_H)|g' \ @@ -656,7 +662,8 @@ $(AM_V_at)$(MKDIR_P) sys $(AM_V_GEN)rm -f $@-t $@ && \ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ - sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ -e 's|@''NEXT_SYS_STAT_H''@|$(NEXT_SYS_STAT_H)|g' \ @@ -714,7 +721,8 @@ time.h: time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) $(AM_V_GEN)rm -f $@-t $@ && \ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ - sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ -e 's|@''NEXT_TIME_H''@|$(NEXT_TIME_H)|g' \ @@ -764,7 +772,8 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) $(AM_V_GEN)rm -f $@-t $@ && \ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ - sed -e 's|@''HAVE_UNISTD_H''@|$(HAVE_UNISTD_H)|g' \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''HAVE_UNISTD_H''@|$(HAVE_UNISTD_H)|g' \ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ === modified file 'lib/intprops.h' --- lib/intprops.h 2011-05-27 16:58:43 +0000 +++ lib/intprops.h 2011-05-29 21:52:18 +0000 @@ -22,9 +22,8 @@ #include -/* Return a integer value, converted to the same type as the integer - expression E after integer type promotion. V is the unconverted value. - E should not have side effects. */ +/* Return an integer value, converted to the same type as the integer + expression E after integer type promotion. V is the unconverted value. */ #define _GL_INT_CONVERT(e, v) (0 * (e) + (v)) /* Act like _GL_INT_CONVERT (E, -V) but work around a bug in IRIX 6.5 cc; see @@ -53,7 +52,7 @@ #define TYPE_SIGNED(t) (! ((t) 0 < (t) -1)) /* Return 1 if the integer expression E, after integer promotion, has - a signed type. E should not have side effects. */ + a signed type. */ #define _GL_INT_SIGNED(e) (_GL_INT_NEGATE_CONVERT (e, 1) < 0) === modified file 'lib/makefile.w32-in' --- lib/makefile.w32-in 2011-05-24 08:12:52 +0000 +++ lib/makefile.w32-in 2011-05-29 21:52:18 +0000 @@ -197,7 +197,8 @@ getopt_h: - $(DEL) getopt_.h-t getopt_.h - sed -e "s!@HAVE_GETOPT_H@!$(HAVE_GETOPT_H)!g" \ + sed -e "s!@GUARD_PREFIX@!GL!g" \ + -e "s!@HAVE_GETOPT_H@!$(HAVE_GETOPT_H)!g" \ -e "s!@INCLUDE_NEXT@!$(INCLUDE_NEXT)!g" \ -e "s!@PRAGMA_SYSTEM_HEADER@!$(PRAGMA_SYSTEM_HEADER)!g" \ -e "s!@PRAGMA_COLUMNS@!$(PRAGMA_COLUMNS)!g" \ === modified file 'lib/stdarg.in.h' --- lib/stdarg.in.h 2011-05-04 07:19:21 +0000 +++ lib/stdarg.in.h 2011-05-29 21:52:18 +0000 @@ -15,7 +15,7 @@ along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ -#ifndef _GL_STDARG_H +#ifndef _@GUARD_PREFIX@_STDARG_H #if __GNUC__ >= 3 @PRAGMA_SYSTEM_HEADER@ @@ -25,12 +25,12 @@ /* The include_next requires a split double-inclusion guard. */ #@INCLUDE_NEXT@ @NEXT_STDARG_H@ -#ifndef _GL_STDARG_H -#define _GL_STDARG_H +#ifndef _@GUARD_PREFIX@_STDARG_H +#define _@GUARD_PREFIX@_STDARG_H #ifndef va_copy # define va_copy(a,b) ((a) = (b)) #endif -#endif /* _GL_STDARG_H */ -#endif /* _GL_STDARG_H */ +#endif /* _@GUARD_PREFIX@_STDARG_H */ +#endif /* _@GUARD_PREFIX@_STDARG_H */ === modified file 'lib/stddef.in.h' --- lib/stddef.in.h 2011-02-06 22:13:03 +0000 +++ lib/stddef.in.h 2011-05-29 21:52:18 +0000 @@ -38,9 +38,9 @@ remember if special invocation has ever been used to obtain wint_t, in which case we need to clean up NULL yet again. */ -# if !(defined _GL_STDDEF_H && defined _GL_STDDEF_WINT_T) +# if !(defined _@GUARD_PREFIX@_STDDEF_H && defined _GL_STDDEF_WINT_T) # ifdef __need_wint_t -# undef _GL_STDDEF_H +# undef _@GUARD_PREFIX@_STDDEF_H # define _GL_STDDEF_WINT_T # endif # @INCLUDE_NEXT@ @NEXT_STDDEF_H@ @@ -49,14 +49,14 @@ #else /* Normal invocation convention. */ -# ifndef _GL_STDDEF_H +# ifndef _@GUARD_PREFIX@_STDDEF_H /* The include_next requires a split double-inclusion guard. */ # @INCLUDE_NEXT@ @NEXT_STDDEF_H@ -# ifndef _GL_STDDEF_H -# define _GL_STDDEF_H +# ifndef _@GUARD_PREFIX@_STDDEF_H +# define _@GUARD_PREFIX@_STDDEF_H /* On NetBSD 5.0, the definition of NULL lacks proper parentheses. */ #if @REPLACE_NULL@ @@ -82,6 +82,6 @@ # define wchar_t int #endif -# endif /* _GL_STDDEF_H */ -# endif /* _GL_STDDEF_H */ +# endif /* _@GUARD_PREFIX@_STDDEF_H */ +# endif /* _@GUARD_PREFIX@_STDDEF_H */ #endif /* __need_XXX */ === modified file 'lib/stdint.in.h' --- lib/stdint.in.h 2011-05-22 21:02:48 +0000 +++ lib/stdint.in.h 2011-05-29 21:52:18 +0000 @@ -21,7 +21,7 @@ * */ -#ifndef _GL_STDINT_H +#ifndef _@GUARD_PREFIX@_STDINT_H #if __GNUC__ >= 3 @PRAGMA_SYSTEM_HEADER@ @@ -52,13 +52,13 @@ /* Other systems may have an incomplete or buggy . Include it before , since any "#include " in would reinclude us, skipping our contents because - _GL_STDINT_H is defined. + _@GUARD_PREFIX@_STDINT_H is defined. The include_next requires a split double-inclusion guard. */ # @INCLUDE_NEXT@ @NEXT_STDINT_H@ #endif -#if ! defined _GL_STDINT_H && ! defined _GL_JUST_INCLUDE_SYSTEM_STDINT_H -#define _GL_STDINT_H +#if ! defined _@GUARD_PREFIX@_STDINT_H && ! defined _GL_JUST_INCLUDE_SYSTEM_STDINT_H +#define _@GUARD_PREFIX@_STDINT_H /* defines some of the stdint.h types as well, on glibc, IRIX 6.5, and OpenBSD 3.8 (via ). @@ -588,5 +588,5 @@ #endif /* !defined __cplusplus || defined __STDC_CONSTANT_MACROS */ -#endif /* _GL_STDINT_H */ -#endif /* !defined _GL_STDINT_H && !defined _GL_JUST_INCLUDE_SYSTEM_STDINT_H */ +#endif /* _@GUARD_PREFIX@_STDINT_H */ +#endif /* !defined _@GUARD_PREFIX@_STDINT_H && !defined _GL_JUST_INCLUDE_SYSTEM_STDINT_H */ === modified file 'lib/stdio.in.h' --- lib/stdio.in.h 2011-04-18 04:03:18 +0000 +++ lib/stdio.in.h 2011-05-29 21:52:18 +0000 @@ -35,7 +35,7 @@ #else /* Normal invocation convention. */ -#ifndef _GL_STDIO_H +#ifndef _@GUARD_PREFIX@_STDIO_H #define _GL_ALREADY_INCLUDING_STDIO_H @@ -44,8 +44,8 @@ #undef _GL_ALREADY_INCLUDING_STDIO_H -#ifndef _GL_STDIO_H -#define _GL_STDIO_H +#ifndef _@GUARD_PREFIX@_STDIO_H +#define _@GUARD_PREFIX@_STDIO_H /* Get va_list. Needed on many systems, including glibc 2.8. */ #include @@ -1345,6 +1345,6 @@ #endif -#endif /* _GL_STDIO_H */ -#endif /* _GL_STDIO_H */ +#endif /* _@GUARD_PREFIX@_STDIO_H */ +#endif /* _@GUARD_PREFIX@_STDIO_H */ #endif === modified file 'lib/stdlib.in.h' --- lib/stdlib.in.h 2011-05-04 06:11:49 +0000 +++ lib/stdlib.in.h 2011-05-29 21:52:18 +0000 @@ -28,13 +28,13 @@ #else /* Normal invocation convention. */ -#ifndef _GL_STDLIB_H +#ifndef _@GUARD_PREFIX@_STDLIB_H /* The include_next requires a split double-inclusion guard. */ #@INCLUDE_NEXT@ @NEXT_STDLIB_H@ -#ifndef _GL_STDLIB_H -#define _GL_STDLIB_H +#ifndef _@GUARD_PREFIX@_STDLIB_H +#define _@GUARD_PREFIX@_STDLIB_H /* NetBSD 5.0 mis-defines NULL. */ #include @@ -761,6 +761,6 @@ #endif -#endif /* _GL_STDLIB_H */ -#endif /* _GL_STDLIB_H */ +#endif /* _@GUARD_PREFIX@_STDLIB_H */ +#endif /* _@GUARD_PREFIX@_STDLIB_H */ #endif === modified file 'lib/sys_stat.in.h' --- lib/sys_stat.in.h 2011-03-13 17:39:04 +0000 +++ lib/sys_stat.in.h 2011-05-29 21:52:18 +0000 @@ -34,7 +34,7 @@ #else /* Normal invocation convention. */ -#ifndef _GL_SYS_STAT_H +#ifndef _@GUARD_PREFIX@_SYS_STAT_H /* Get nlink_t. */ #include @@ -45,8 +45,8 @@ /* The include_next requires a split double-inclusion guard. */ #@INCLUDE_NEXT@ @NEXT_SYS_STAT_H@ -#ifndef _GL_SYS_STAT_H -#define _GL_SYS_STAT_H +#ifndef _@GUARD_PREFIX@_SYS_STAT_H +#define _@GUARD_PREFIX@_SYS_STAT_H /* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */ @@ -653,6 +653,6 @@ #endif -#endif /* _GL_SYS_STAT_H */ -#endif /* _GL_SYS_STAT_H */ +#endif /* _@GUARD_PREFIX@_SYS_STAT_H */ +#endif /* _@GUARD_PREFIX@_SYS_STAT_H */ #endif === modified file 'lib/time.in.h' --- lib/time.in.h 2011-02-07 01:01:26 +0000 +++ lib/time.in.h 2011-05-29 21:52:18 +0000 @@ -28,13 +28,13 @@ without adding our own declarations. */ #if (defined __need_time_t || defined __need_clock_t \ || defined __need_timespec \ - || defined _GL_TIME_H) + || defined _@GUARD_PREFIX@_TIME_H) # @INCLUDE_NEXT@ @NEXT_TIME_H@ #else -# define _GL_TIME_H +# define _@GUARD_PREFIX@_TIME_H # @INCLUDE_NEXT@ @NEXT_TIME_H@ === modified file 'lib/unistd.in.h' --- lib/unistd.in.h 2011-05-18 00:39:40 +0000 +++ lib/unistd.in.h 2011-05-29 21:52:18 +0000 @@ -36,7 +36,7 @@ # define _GL_WINSOCK2_H_WITNESS /* Normal invocation. */ -#elif !defined _GL_UNISTD_H +#elif !defined _@GUARD_PREFIX@_UNISTD_H /* The include_next requires a split double-inclusion guard. */ #if @HAVE_UNISTD_H@ @@ -51,8 +51,8 @@ # undef _GL_INCLUDING_WINSOCK2_H #endif -#if !defined _GL_UNISTD_H && !defined _GL_INCLUDING_WINSOCK2_H -#define _GL_UNISTD_H +#if !defined _@GUARD_PREFIX@_UNISTD_H && !defined _GL_INCLUDING_WINSOCK2_H +#define _@GUARD_PREFIX@_UNISTD_H /* NetBSD 5.0 mis-defines NULL. Also get size_t. */ #include @@ -120,7 +120,7 @@ #if @GNULIB_GETHOSTNAME@ /* Get all possible declarations of gethostname(). */ # if @UNISTD_H_HAVE_WINSOCK2_H@ -# if !defined _GL_SYS_SOCKET_H +# if !defined _@GUARD_PREFIX@_SYS_SOCKET_H # if !(defined __cplusplus && defined GNULIB_NAMESPACE) # undef socket # define socket socket_used_without_including_sys_socket_h @@ -181,7 +181,7 @@ "shutdown() used without including "); # endif # endif -# if !defined _GL_SYS_SELECT_H +# if !defined _@GUARD_PREFIX@_SYS_SELECT_H # if !(defined __cplusplus && defined GNULIB_NAMESPACE) # undef select # define select select_used_without_including_sys_select_h @@ -1416,5 +1416,5 @@ #endif -#endif /* _GL_UNISTD_H */ -#endif /* _GL_UNISTD_H */ +#endif /* _@GUARD_PREFIX@_UNISTD_H */ +#endif /* _@GUARD_PREFIX@_UNISTD_H */ === modified file 'lib/verify.h' --- lib/verify.h 2011-05-23 21:53:22 +0000 +++ lib/verify.h 2011-05-29 21:52:18 +0000 @@ -164,10 +164,13 @@ (!!sizeof (_GL_VERIFY_TYPE (R, DIAGNOSTIC))) # ifdef __cplusplus +# if !GNULIB_defined_struct__gl_verify_type template struct _gl_verify_type { unsigned int _gl_verify_error_if_negative: w; }; +# define GNULIB_defined_struct__gl_verify_type 1 +# endif # define _GL_VERIFY_TYPE(R, DIAGNOSTIC) \ _gl_verify_type<(R) ? 1 : -1> # elif defined _GL_HAVE__STATIC_ASSERT @@ -206,7 +209,7 @@ # endif # endif -# ifdef _GL_VERIFY_H +/* @assert.h omit start@ */ /* Each of these macros verifies that its argument R is nonzero. To be portable, R should be an integer constant expression. Unlike @@ -220,13 +223,13 @@ /* Verify requirement R at compile-time, as an integer constant expression. Return 1. */ -# define verify_true(R) _GL_VERIFY_TRUE (R, "verify_true (" #R ")") +# define verify_true(R) _GL_VERIFY_TRUE (R, "verify_true (" #R ")") /* Verify requirement R at compile-time, as a declaration without a trailing ';'. */ -# define verify(R) _GL_VERIFY (R, "verify (" #R ")") +# define verify(R) _GL_VERIFY (R, "verify (" #R ")") -# endif +/* @assert.h omit end@ */ #endif === modified file 'm4/getloadavg.m4' --- m4/getloadavg.m4 2011-02-18 07:41:43 +0000 +++ m4/getloadavg.m4 2011-05-29 21:52:18 +0000 @@ -7,23 +7,19 @@ # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. -#serial 2 +#serial 3 # Autoconf defines AC_FUNC_GETLOADAVG, but that is obsolescent. # New applications should use gl_GETLOADAVG instead. -# gl_GETLOADAVG(LIBOBJDIR) -# ------------------------ +# gl_GETLOADAVG +# ------------- AC_DEFUN([gl_GETLOADAVG], [AC_REQUIRE([gl_STDLIB_H_DEFAULTS]) # Persuade glibc to declare getloadavg(). AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS]) -# Make sure getloadavg.c is where it belongs, at configure-time. -test -f "$srcdir/$1/getloadavg.c" || - AC_MSG_ERROR([$srcdir/$1/getloadavg.c is missing]) - gl_save_LIBS=$LIBS # getloadvg is present in libc on glibc >= 2.2, MacOS X, FreeBSD >= 2.0, === modified file 'm4/gl-comp.m4' --- m4/gl-comp.m4 2011-05-24 08:12:52 +0000 +++ m4/gl-comp.m4 2011-05-29 21:52:18 +0000 @@ -96,7 +96,7 @@ gl_SHA1 AC_REQUIRE([gl_C99_STRTOLD]) gl_FILEMODE -gl_GETLOADAVG([$gl_source_base]) +gl_GETLOADAVG gl_STDLIB_MODULE_INDICATOR([getloadavg]) gl_FUNC_GETOPT_GNU gl_MODULE_INDICATOR_FOR_TESTS([getopt-gnu]) ------------------------------------------------------------ revno: 104427 committer: Chong Yidong branch nick: trunk timestamp: Sun 2011-05-29 17:35:35 -0400 message: Fix animated gifs (Bug#6981). * lisp/image-mode.el (image-toggle-display-image): Ensure that the image spec passed to the animate timer is the same object as in the the buffer's display property. (image-transform-properties): Doc fix. * lisp/image.el (image-animate-max-time): Default to nil. * lisp/image.el (image-animate-max-time): Allow nil and t values. Default to nil. (create-animated-image): Doc fix. (image-animate-start): Remove second arg; just use image-animate-max-time. (image-animate-timeout): Doc fix. Args changed. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-29 19:11:23 +0000 +++ lisp/ChangeLog 2011-05-29 21:35:35 +0000 @@ -1,3 +1,19 @@ +2011-05-29 Chong Yidong + + * image.el (image-animate-max-time): Allow nil and t values. + Default to nil. + (create-animated-image): Doc fix. + (image-animate-start): Remove second arg; just use + image-animate-max-time. + (image-animate-timeout): Doc fix. Args changed. + + * image-mode.el (image-toggle-display-image): Ensure that the + image spec passed to the animate timer is the same object as in + the the buffer's display property (Bug#6981). + (image-transform-properties): Doc fix. + + * image.el (image-animate-max-time): Default to nil. + 2011-05-29 Martin Rudalics * menu-bar.el (kill-this-buffer-enabled-p): Avoid looping over === modified file 'lisp/image-mode.el' --- lisp/image-mode.el 2011-05-21 02:09:49 +0000 +++ lisp/image-mode.el 2011-05-29 21:35:35 +0000 @@ -484,18 +484,26 @@ (buffer-substring-no-properties (point-min) (point-max))) filename)) (type (image-type file-or-data nil data-p)) - (image0 (create-animated-image file-or-data type data-p)) - (image (append image0 - (image-transform-properties image0))) - (props + ;; Don't use create-animated-image here; that would start the + ;; timer, which works by altering the spec destructively. + ;; But we still need to append the transformation properties, + ;; which would make a new list. + (image (create-image file-or-data type data-p)) + (inhibit-read-only t) + (buffer-undo-list t) + (modified (buffer-modified-p)) + props) + + (setq image (append image (image-transform-properties image))) + (setq props `(display ,image intangible ,image rear-nonsticky (display intangible) read-only t front-sticky (read-only))) - (inhibit-read-only t) - (buffer-undo-list t) - (modified (buffer-modified-p))) (image-flush image) + ;; Begin the animation, if any. + (image-animate-start image) + (let ((buffer-file-truename nil)) ; avoid changing dir mtime by lock_file (add-text-properties (point-min) (point-max) props) (restore-buffer-modified-p modified)) @@ -584,10 +592,13 @@ (defvar image-transform-rotation 0.0) (defun image-transform-properties (display) - "Rescale and/or rotate the current image. -The scale factor and rotation angle are given by the variables -`image-transform-resize' and `image-transform-rotation'. This -takes effect only if Emacs is compiled with ImageMagick support." + "Return rescaling/rotation properties for the Image mode buffer. +These properties are suitable for appending to an image spec; +they are determined by the variables `image-transform-resize' and +`image-transform-rotation'. + +Recaling and rotation properties only take effect if Emacs is +compiled with ImageMagick support." (let* ((size (image-size display t)) (height (cond === modified file 'lisp/image.el' --- lisp/image.el 2011-05-29 18:17:28 +0000 +++ lisp/image.el 2011-05-29 21:35:35 +0000 @@ -590,9 +590,13 @@ ;;; Animated image API -(defcustom image-animate-max-time 30 - "Time in seconds to animate images." - :type 'integer +(defcustom image-animate-max-time nil + "Time in seconds to animate images. +If the value is nil, play animations once. +If the value is t, loop forever." + :type '(choice (const :tag "Play once" nil) + (const :tag "Loop forever" t) + integer) :version "24.1" :group 'image) @@ -601,7 +605,7 @@ ;;;###autoload (defun create-animated-image (file-or-data &optional type data-p &rest props) - "Create an animated image. + "Create an animated image, and begin animating it. FILE-OR-DATA is an image file name or image data. Optional TYPE is a symbol describing the image type. If TYPE is omitted or nil, try to determine the image type from its first few bytes @@ -638,22 +642,20 @@ (setq timer nil))) timer)) -(defun image-animate-start (image &optional max-time) - "Start animation of image IMAGE. -Optional second arg MAX-TIME is number of seconds to animate image, -or t to animate infinitely." +(defun image-animate-start (image) + "Start animating the image IMAGE. +The variable `image-animate-max-time' determines how long to +animate for." (let ((anim (image-animated-p image)) - timer tmo) + delay ; in seconds + timer) (when anim (if (setq timer (image-animate-timer image)) - (setcar (nthcdr 3 (aref timer 6)) max-time) - (setq tmo (* (cdr anim) 0.01)) - (setq max-time (or max-time image-animate-max-time)) - (run-with-timer tmo nil #'image-animate-timeout - image 1 (car anim) - (if (numberp max-time) - (- max-time tmo) - max-time)))))) + (cancel-timer timer)) + (setq delay (max (* (cdr anim) 0.01) 0.025)) + (run-with-timer 0.2 nil #'image-animate-timeout + image 0 (car anim) + delay 0 image-animate-max-time)))) (defun image-animate-stop (image) "Stop animation of image." @@ -661,20 +663,31 @@ (when timer (cancel-timer timer)))) -(defun image-animate-timeout (image ino count time-left) - (if (>= ino count) - (setq ino 0)) - (plist-put (cdr image) :index ino) - (force-window-update) - (let ((anim (image-animated-p image)) tmo) - (when anim - (setq tmo (* (cdr anim) 0.01)) - (unless (and (= ino 0) (numberp time-left) (< time-left tmo)) - (run-with-timer tmo nil #'image-animate-timeout - image (1+ ino) count - (if (numberp time-left) - (- time-left tmo) - time-left)))))) +(defun image-animate-timeout (image n count delay time-elapsed max) + "Display animation frame N of IMAGE. +N=0 refers to the initial animation frame. +COUNT is the total number of frames in the animation. +DELAY is the time between animation frames, in seconds. +TIME-ELAPSED is the total time that has elapsed since +`image-animate-start' was called. +MAX determines when to stop. If t, loop forever. If nil, stop + after displaying the last animation frame. Otherwise, stop + after MAX seconds have elapsed." + (let (done) + (plist-put (cdr image) :index n) + (force-window-update) + (setq n (1+ n)) + (if (>= n count) + (if max + (setq n 0) + (setq done t))) + (setq time-elapsed (+ delay time-elapsed)) + (if (numberp max) + (setq done (>= time-elapsed max))) + (unless done + (run-with-timer delay nil 'image-animate-timeout + image n count delay + time-elapsed max)))) (defun image-animated-p (image) "Return non-nil if image is animated. ------------------------------------------------------------ revno: 104426 committer: Eli Zaretskii branch nick: trunk timestamp: Mon 2011-05-30 00:09:52 +0300 message: src/coding.c: Fix a typo in a comment. diff: === modified file 'src/coding.c' --- src/coding.c 2011-05-12 07:07:06 +0000 +++ src/coding.c 2011-05-29 21:09:52 +0000 @@ -55,8 +55,8 @@ character sequence of emacs-utf-8 to a byte sequence of a specific coding system. - In Emacs Lisp, a coding system is represented by a Lisp symbol. In - C level, a coding system is represented by a vector of attributes + In Emacs Lisp, a coding system is represented by a Lisp symbol. On + the C level, a coding system is represented by a vector of attributes stored in the hash table Vcharset_hash_table. The conversion from coding system symbol to attributes vector is done by looking up Vcharset_hash_table by the symbol. ------------------------------------------------------------ revno: 104425 author: Martin Rudalics committer: Chong Yidong branch nick: trunk timestamp: Sun 2011-05-29 15:11:23 -0400 message: * menu-bar.el (kill-this-buffer-enabled-p): Avoid looping over entire buffer list (Bug#8184). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-29 18:17:28 +0000 +++ lisp/ChangeLog 2011-05-29 19:11:23 +0000 @@ -1,3 +1,8 @@ +2011-05-29 Martin Rudalics + + * menu-bar.el (kill-this-buffer-enabled-p): Avoid looping over + entire buffer list (Bug#8184). + 2011-05-29 Chong Yidong * image.el (imagemagick-types-inhibit) === modified file 'lisp/menu-bar.el' --- lisp/menu-bar.el 2011-02-10 16:56:00 +0000 +++ lisp/menu-bar.el 2011-05-29 19:11:23 +0000 @@ -1823,14 +1823,17 @@ (abort-recursive-edit))) (defun kill-this-buffer-enabled-p () - (let ((count 0) - (buffers (buffer-list))) - (while buffers - (or (string-match "^ " (buffer-name (car buffers))) - (setq count (1+ count))) - (setq buffers (cdr buffers))) - (or (not (menu-bar-non-minibuffer-window-p)) - (> count 1)))) + "Return non-nil if the `kill-this-buffer' menu item should be enabled." + (or (not (menu-bar-non-minibuffer-window-p)) + (let (found-1) + ;; Instead of looping over entire buffer list, stop once we've + ;; found two "killable" buffers (Bug#8184). + (catch 'found-2 + (dolist (buffer (buffer-list)) + (unless (string-match-p "^ " (buffer-name buffer)) + (if (not found-1) + (setq found-1 t) + (throw 'found-2 t)))))))) (put 'dired 'menu-enable '(menu-bar-non-minibuffer-window-p)) ------------------------------------------------------------ revno: 104424 committer: Eli Zaretskii branch nick: trunk timestamp: Sun 2011-05-29 22:04:01 +0300 message: src/font.[ch]: Fix typos in comments and strings. diff: === modified file 'src/font.c' --- src/font.c 2011-05-12 07:07:06 +0000 +++ src/font.c 2011-05-29 19:04:01 +0000 @@ -136,7 +136,7 @@ static Lisp_Object QCuser_spec; -/* Alist of font registry symbol and the corresponding charsets +/* Alist of font registry symbols and the corresponding charset information. The information is retrieved from Vfont_encoding_alist on demand. @@ -226,9 +226,9 @@ /* Return a Lispy value of a font property value at STR and LEN bytes. - If STR is "*", it returns nil. - If FORCE_SYMBOL is zero and all characters in STR are digits, it - returns an integer. Otherwise, it returns a symbol interned from + If STR is "*", return nil. + If FORCE_SYMBOL is zero and all characters in STR are digits, + return an integer. Otherwise, return a symbol interned from STR. */ Lisp_Object @@ -251,7 +251,7 @@ } /* The following code is copied from the function intern (in - lread.c), and modified to suite our purpose. */ + lread.c), and modified to suit our purpose. */ obarray = Vobarray; if (!VECTORP (obarray) || ASIZE (obarray) == 0) obarray = check_obarray (obarray); @@ -305,7 +305,7 @@ font vector. If VAL is not valid (i.e. not registered in font_style_table), return -1 if NOERROR is zero, and return a proper index if NOERROR is nonzero. In that case, register VAL in - font_style_table if VAL is a symbol, and return a closest index if + font_style_table if VAL is a symbol, and return the closest index if VAL is an integer. */ int @@ -473,7 +473,7 @@ } -/* Font property value validaters. See the comment of +/* Font property value validators. See the comment of font_property_table for the meaning of the arguments. */ static Lisp_Object font_prop_validate (int, Lisp_Object, Lisp_Object); @@ -591,7 +591,7 @@ return val; } -/* Structure of known font property keys and validater of the +/* Structure of known font property keys and validator of the values. */ static const struct { @@ -742,7 +742,7 @@ }; -/* Parse P pointing the pixel/point size field of the form +/* Parse P pointing to the pixel/point size field of the form `[A B C D]' which specifies a transformation matrix: A B 0 @@ -775,7 +775,7 @@ } /* Expand a wildcard field in FIELD (the first N fields are filled) to - multiple fields to fill in all 14 XLFD fields while restring a + multiple fields to fill in all 14 XLFD fields while restricting a field position by its contents. */ static int @@ -2054,14 +2054,14 @@ font-spec. The score value is 32 bit (`unsigned'), and the smaller the value is, the closer the font is to the font-spec. - The lowest 2 bits of the score is used for driver type. The font + The lowest 2 bits of the score are used for driver type. The font available by the most preferred font driver is 0. - Each 7-bit in the higher 28 bits are used for numeric properties + The 4 7-bit fields in the higher 28 bits are used for numeric properties WEIGHT, SLANT, WIDTH, and SIZE. */ /* How many bits to shift to store the difference value of each font - property in a score. Note that flots for FONT_TYPE_INDEX and + property in a score. Note that floats for FONT_TYPE_INDEX and FONT_REGISTRY_INDEX are not used. */ static int sort_shift_bits[FONT_SIZE_INDEX + 1]; @@ -2598,7 +2598,7 @@ static Lisp_Object scratch_font_spec, scratch_font_prefer; /* Check each font-entity in VEC, and return a list of font-entities - that satisfy this condition: + that satisfy these conditions: (1) matches with SPEC and SIZE if SPEC is not nil, and (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil). */ @@ -3018,8 +3018,8 @@ attrs[LFACE_FONT_INDEX] = font; } -/* Selecte a font from ENTITIES (list of font-entity vectors) that - supports C and matches best with ATTRS and PIXEL_SIZE. */ +/* Select a font from ENTITIES (list of font-entity vectors) that + supports C and is the best match for ATTRS and PIXEL_SIZE. */ static Lisp_Object font_select_entity (Lisp_Object frame, Lisp_Object entities, Lisp_Object *attrs, int pixel_size, int c) @@ -3062,8 +3062,8 @@ return font_sort_entities (entities, prefer, frame, c); } -/* Return a font-entity satisfying SPEC and best matching with face's - font related attributes in ATTRS. C, if not negative, is a +/* Return a font-entity that satisfies SPEC and is the best match for + face's font related attributes in ATTRS. C, if not negative, is a character that the entity must support. */ Lisp_Object @@ -3254,8 +3254,8 @@ } -/* Find a font satisfying SPEC and best matching with face's - attributes in ATTRS on FRAME, and return the opened +/* Find a font that satisfies SPEC and is the best match for + face's attributes in ATTRS on FRAME, and return the opened font-object. */ Lisp_Object @@ -3267,8 +3267,7 @@ if (NILP (entity)) { /* No font is listed for SPEC, but each font-backend may have - the different criteria about "font matching". So, try - it. */ + different criteria about "font matching". So, try it. */ entity = font_matching_entity (f, attrs, spec); if (NILP (entity)) return Qnil; @@ -3307,7 +3306,7 @@ } -/* Open a font matching with font-spec SPEC on frame F. If no proper +/* Open a font that is a match for font-spec SPEC on frame F. If no proper font is found, return Qnil. */ Lisp_Object @@ -3331,7 +3330,7 @@ } -/* Open a font matching with NAME on frame F. If no proper font is +/* Open a font that matches NAME on frame F. If no proper font is found, return Qnil. */ Lisp_Object @@ -3355,7 +3354,7 @@ /* Register font-driver DRIVER. This function is used in two ways. The first is with frame F non-NULL. In this case, make DRIVER - available (but not yet activated) on F. All frame creaters + available (but not yet activated) on F. All frame creators (e.g. Fx_create_frame) must call this function at least once with an available font-driver. @@ -3682,7 +3681,7 @@ #ifdef HAVE_WINDOW_SYSTEM /* Check how many characters after POS (at most to *LIMIT) can be - displayed by the same font on the window W. FACE, if non-NULL, is + displayed by the same font in the window W. FACE, if non-NULL, is the face selected for the character at POS. If STRING is not nil, it is the string to check instead of the current buffer. In that case, FACE must be not NULL. @@ -3826,7 +3825,7 @@ must not have any of the remaining elements. For instance, if the VALUE is `(thai nil nil (mark))', the font must -be an OpenType font, and whose GPOS table of `thai' script's default +be an OpenType font whose GPOS table of `thai' script's default language system must contain `mark' feature. usage: (font-spec ARGS...) */) @@ -4189,7 +4188,7 @@ FONT is a font-spec, font-entity, or font-object. If the name is too long for XLFD (maximum 255 chars), return nil. If the 2nd optional arg FOLD-WILDCARDS is non-nil, -the consecutive wildcards are folded to one. */) +the consecutive wildcards are folded into one. */) (Lisp_Object font, Lisp_Object fold_wildcards) { char name[256]; @@ -4436,7 +4435,7 @@ If GSTRING-OUT is too short to hold produced glyphs, no glyphs are produced in GSTRING-OUT, and the value is nil. -See the documentation of `font-make-gstring' for the format of +See the documentation of `composition-get-gstring' for the format of glyph-string. */) (Lisp_Object otf_features, Lisp_Object gstring_in, Lisp_Object from, Lisp_Object to, Lisp_Object gstring_out, Lisp_Object index) { @@ -4571,10 +4570,10 @@ [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH CAPABILITY ] -NAME is a string of the font name (or nil if the font backend doesn't +NAME is the font name, a string (or nil if the font backend doesn't provide a name). -FILENAME is a string of the font file (or nil if the font backend +FILENAME is the font file name, a string (or nil if the font backend doesn't provide a file name). PIXEL-SIZE is a pixel size by which the font is opened. === modified file 'src/font.h' --- src/font.h 2011-05-12 07:07:06 +0000 +++ src/font.h 2011-05-29 19:04:01 +0000 @@ -36,22 +36,22 @@ FONT-ENTITY - Pseudo vector (length FONT_ENTITY_MAX) of fully instanciated + Pseudo vector (length FONT_ENTITY_MAX) of fully instantiated font properties that a font-driver returns upon a request of FONT-SPEC. Note: Only the method `list' and `match' of a font-driver can - create this object, and should never be modified by Lisp. + create this object, and it should never be modified by Lisp. FONT-OBJECT - Pseudo vector (length FONT_OBJECT_MAX) of a opend font. + Pseudo vector (length FONT_OBJECT_MAX) of an opened font. Lisp object encapsulating "struct font". This corresponds to an opened font. Note: Only the method `open' of a font-driver can create this - object, and should never be modified by Lisp. */ + object, and it should never be modified by Lisp. */ extern Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; @@ -68,7 +68,7 @@ enum font_property_index { /* FONT-TYPE is a symbol indicating a font backend; currently `x', - `xft', `ftx' are available on X, `uniscribe' and `gdi' on + `xft', and `ftx' are available on X, `uniscribe' and `gdi' on Windows, and `ns' under Cocoa / GNUstep. */ FONT_TYPE_INDEX, @@ -86,26 +86,26 @@ FONT_REGISTRY_INDEX, /* FONT-WEIGHT is a numeric value of weight (e.g. medium, bold) of - the font. The lowest 8-bit is an index determining the + the font. The lowest 8 bits is an index determining the symbolic name, and the higher bits is the actual numeric value defined in `font-weight-table'. */ FONT_WEIGHT_INDEX, /* FONT-SLANT is a numeric value of slant (e.g. r, i, o) of the - font. The lowest 8-bit is an index determining the symbolic + font. The lowest 8 bits is an index determining the symbolic name, and the higher bits is the actual numeric value defined in `font-slant-table'. */ FONT_SLANT_INDEX, /* FONT-WIDTH is a numeric value of setwidth (e.g. normal) of the - font. The lowest 8-bit is an index determining the symbolic + font. The lowest 8 bits is an index determining the symbolic name, and the higher bits is the actual numeric value defined `font-width-table'. */ FONT_WIDTH_INDEX, /* FONT-SIZE is a size of the font. If integer, it is a pixel - size. For a font-spec, the value can be float specifying a - point size. The value zero means that the font is + size. For a font-spec, the value can be a float specifying + the point size. The value zero means that the font is scalable. */ FONT_SIZE_INDEX, @@ -129,18 +129,18 @@ /* FONT-STYLE is a 24-bit integer containing indices for style-related properties WEIGHT, SLANT, and WIDTH. The lowest - 8-bit is an indice to the weight table AREF (font_style_table, - 0), the next 8-bit is an indice to the slant table AREF - (font_style_table, 1), the highest 8-bit is an indice to the - slant table AREF (font_style_table, 2). The indice 0 indicates + 8 bits is an index to the weight table AREF (font_style_table, + 0), the next 8 bits is an index to the slant table AREF + (font_style_table, 1), the highest 8 bits is an index to the + slant table AREF (font_style_table, 2). The index 0 indicates that the corresponding style is not specified. This way, we can represent at most 255 different names for each style, which is surely sufficient. */ FONT_STYLE_INDEX, /* FONT-METRICS is a 27-bit integer containing metrics-related - properties DPI, AVGWIDTH, SPACING. The lowest 12-bit is for - DPI, the next 12-bit is for AVGWIDTH, the highest 3-bit is for + properties DPI, AVGWIDTH, SPACING. The lowest 12 bits is for + DPI, the next 12 bits is for AVGWIDTH, the highest 3 bits is for SPACING. In each bit field, the highest bit indicates that the corresponding value is set or not. This way, we can represent DPI by 11-bit (0 to 2047), AVGWIDTH by 11-bit (0 to 2047), @@ -176,7 +176,7 @@ FONT_NAME_INDEX = FONT_ENTITY_MAX, /* Full name of the font (string). It is the name extracted from - the opend font, and may be different from the above. It may be + the opened font, and may be different from the above. It may be nil if the opened font doesn't give a name. */ FONT_FULLNAME_INDEX, @@ -300,7 +300,7 @@ int space_width; /* Average width of glyphs in the font. If the font itself doesn't - have that information but has glyphs of ASCII character, the + have that information but has glyphs of ASCII characters, the value is the average with of those glyphs. Otherwise, the value is 0. */ int average_width; @@ -321,7 +321,7 @@ int underline_position; /* 1 if `vertical-centering-font-regexp' matches this font name. - In this case, we render characters at vartical center positions + In this case, we render characters at vertical center positions of lines. */ int vertical_centering; @@ -335,27 +335,27 @@ unsigned char encoding_type; /* The baseline position of a font is normally `ascent' value of the - font. However, there exists many fonts which don't set `ascent' + font. However, there exist many fonts which don't set `ascent' to an appropriate value to be used as baseline position. This is typical in such ASCII fonts which are designed to be used with Chinese, Japanese, Korean characters. When we use mixture of such fonts and normal fonts (having correct `ascent' value), a display line gets very ugly. Since we have no way to fix it - automatically, it is users responsibility to supply well designed + automatically, it is user's responsibility to supply well designed fonts or correct `ascent' value of fonts. But, the latter requires heavy work (modifying all bitmap data in BDF files). So, Emacs accepts a private font property `_MULE_BASELINE_OFFSET'. If a font has this property, we calculate the baseline position by subtracting the value from - `ascent'. In other words, the value indicates how many bits - higher we should draw a character of the font than normal ASCII - text for a better looking. + `ascent'. In other words, the value indicates how many pixels + higher than normal ASCII text we should draw a character of the + font for better appearance. We also have to consider the fact that the concept of `baseline' differs among scripts to which each character belongs. For - instance, baseline should be at the bottom most position of all + instance, baseline should be at the bottom-most position of all glyphs for Chinese, Japanese, and Korean. But, many of existing - fonts for those characters doesn't have correct `ascent' values + fonts for those characters don't have correct `ascent' values because they are designed to be used with ASCII fonts. To display characters of different language on the same line, the best way will be to arrange them in the middle of the line. So, @@ -365,20 +365,20 @@ of a line. */ int baseline_offset; - /* Non zero means a character should be composed at a position + /* Non-zero means a character should be composed at a position relative to the height (or depth) of previous glyphs in the following cases: (1) The bottom of the character is higher than this value. In this case, the character is drawn above the previous glyphs. (2) The top of the character is lower than 0 (i.e. baseline - height). In this case, the character is drawn beneath the + height). In this case, the character is drawn below the previous glyphs. This value is taken from a private font property `_MULE_RELATIVE_COMPOSE' which is introduced by Emacs. */ int relative_compose; - /* Non zero means an ascent value to be used for a character + /* Non-zero means an ascent value to be used for a character registered in char-table `use-default-ascent'. */ int default_ascent; @@ -398,8 +398,8 @@ determine it. */ int repertory_charset; - /* There will be more to this structure, but they are private to a - font-driver. */ + /* There are more members in this structure, but they are private + to the font-driver. */ }; enum font_spacing @@ -484,8 +484,8 @@ #define POINT_TO_PIXEL(POINT, DPI) ((POINT) * (DPI) / PT_PER_INCH + 0.5) /* Return a point size corresponding to POINT size (integer) - on resolution DPI. Note that though point size is a double, we expect - it to be rounded to an int, so we add 0.5 here. If the desired value + on resolution DPI. Note that though point size is a double, we expect + it to be rounded to an int, so we add 0.5 here. If the desired value is tenths of points (as in xfld specs), then the pixel size should be multiplied BEFORE the conversion to avoid magnifying the error. */ #define PIXEL_TO_POINT(PIXEL, DPI) ((PIXEL) * PT_PER_INCH / (DPI) + 0.5) @@ -582,7 +582,7 @@ If FONT doesn't have such a glyph, return FONT_INVALID_CODE. */ unsigned (*encode_char) (struct font *font, int c); - /* Computate the total metrics of the NGLYPHS glyphs specified by + /* Compute the total metrics of the NGLYPHS glyphs specified by the font FONT and the sequence of glyph codes CODE, and store the result in METRICS. */ int (*text_extents) (struct font *font, @@ -635,7 +635,7 @@ FEATURES specifies which OTF features to apply in this format: (SCRIPT LANGSYS GSUB-FEATURE GPOS-FEATURE) - See the documentation of `font-drive-otf' for the detail. + See the documentation of `font-drive-otf' for the details. This method applies the specified features to the codes in the elements of GSTRING-IN (between FROMth and TOth). The output @@ -710,7 +710,7 @@ struct font_driver_list { - /* 1 iff this driver is currently used. It is igonred in the global + /* 1 iff this driver is currently used. It is ignored in the global font driver list.*/ int on; /* Pointer to the font driver. */ ------------------------------------------------------------ revno: 104423 committer: Chong Yidong branch nick: trunk timestamp: Sun 2011-05-29 15:00:00 -0400 message: Clarify Remapping Commands node in Lisp manual (Bug#8350). * keymaps.texi (Remapping Commands): Emphasize that the keymap needs to be active. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2011-05-28 19:58:43 +0000 +++ doc/lispref/ChangeLog 2011-05-29 19:00:00 +0000 @@ -1,3 +1,8 @@ +2011-05-29 Chong Yidong + + * keymaps.texi (Remapping Commands): Emphasize that the keymap + needs to be active (Bug#8350). + 2011-05-28 Chong Yidong * minibuf.texi (Reading File Names): Clarify (Bug#8480). === modified file 'doc/lispref/keymaps.texi' --- doc/lispref/keymaps.texi 2011-05-19 06:54:27 +0000 +++ doc/lispref/keymaps.texi 2011-05-29 19:00:00 +0000 @@ -1468,33 +1468,33 @@ @section Remapping Commands @cindex remapping commands - A special kind of key binding, using a special ``key sequence'' -which includes a command name, has the effect of @dfn{remapping} that -command into another. Here's how it works. You make a key binding -for a key sequence that starts with the dummy event @code{remap}, -followed by the command name you want to remap. Specify the remapped -definition as the definition in this binding. The remapped definition -is usually a command name, but it can be any valid definition for -a key binding. + A special kind of key binding can be used to @dfn{remap} one command +to another, without having to refer to the key sequence(s) bound to +the original command. To use this feature, make a key binding for a +key sequence that starts with the dummy event @code{remap}, followed +by the command name you want to remap; for the binding, specify the +new definition (usually a command name, but possibly any other valid +definition for a key binding). - Here's an example. Suppose that My mode uses special commands -@code{my-kill-line} and @code{my-kill-word}, which should be invoked -instead of @code{kill-line} and @code{kill-word}. It can establish -this by making these two command-remapping bindings in its keymap: + For example, suppose My mode provides a special command +@code{my-kill-line}, which should be invoked instead of +@code{kill-line}. To establish this, its mode keymap should contain +the following remapping: @smallexample (define-key my-mode-map [remap kill-line] 'my-kill-line) -(define-key my-mode-map [remap kill-word] 'my-kill-word) @end smallexample -Whenever @code{my-mode-map} is an active keymap, if the user types -@kbd{C-k}, Emacs will find the standard global binding of -@code{kill-line} (assuming nobody has changed it). But -@code{my-mode-map} remaps @code{kill-line} to @code{my-kill-line}, -so instead of running @code{kill-line}, Emacs runs -@code{my-kill-line}. +@noindent +Then, whenever @code{my-mode-map} is active, if the user types +@kbd{C-k} (the default global key sequence for @code{kill-line}) Emacs +will instead run @code{my-kill-line}. -Remapping only works through a single level. In other words, + Note that remapping only takes place through active keymaps; for +example, putting a remapping in a prefix keymap like @code{ctl-x-map} +typically has no effect, as such keymaps are not themselves active. +In addition, remapping only works through a single level; in the +following example, @smallexample (define-key my-mode-map [remap kill-line] 'my-kill-line) @@ -1502,11 +1502,10 @@ @end smallexample @noindent -does not have the effect of remapping @code{kill-line} into -@code{my-other-kill-line}. If an ordinary key binding specifies -@code{kill-line}, this keymap will remap it to @code{my-kill-line}; -if an ordinary binding specifies @code{my-kill-line}, this keymap will -remap it to @code{my-other-kill-line}. +@code{kill-line} is @emph{not} remapped to @code{my-other-kill-line}. +Instead, if an ordinary key binding specifies @code{kill-line}, it is +remapped to @code{my-kill-line}; if an ordinary binding specifies +@code{my-kill-line}, it is remapped to @code{my-other-kill-line}. To undo the remapping of a command, remap it to @code{nil}; e.g. ------------------------------------------------------------ revno: 104422 committer: Chong Yidong branch nick: trunk timestamp: Sun 2011-05-29 14:17:28 -0400 message: Doc fixes for imagemagick support code. * lisp/image.el (imagemagick-types-inhibit) (imagemagick-register-types): Doc fix. * src/image.c: Various fixes to ImageMagick code comments. (Fimagemagick_types): Doc fix. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-29 05:42:00 +0000 +++ lisp/ChangeLog 2011-05-29 18:17:28 +0000 @@ -1,3 +1,8 @@ +2011-05-29 Chong Yidong + + * image.el (imagemagick-types-inhibit) + (imagemagick-register-types): Doc fix. + 2011-05-29 Deniz Dogan * net/rcirc.el (rcirc): Use the user's stored encryption method by === modified file 'lisp/image.el' --- lisp/image.el 2011-03-22 13:10:43 +0000 +++ lisp/image.el 2011-05-29 18:17:28 +0000 @@ -698,31 +698,38 @@ (defcustom imagemagick-types-inhibit '(C HTML HTM TXT PDF) - ;; FIXME what are the possible options? - ;; Are these actually file-name extensions? - ;; Why are these upper-case when eg image-types is lower-case? - "Types the ImageMagick loader should not try to handle." - :type '(choice (const :tag "Let ImageMagick handle all the types it can" nil) + "ImageMagick types that Emacs should not use ImageMagick to handle. +This should be a list of symbols, each of which has the same +names as one of the format tags used internally by ImageMagick; +see `imagemagick-types'. Entries in this list are excluded from +being registered by `imagemagick-register-types'. + +If Emacs is compiled without ImageMagick, this variable has no effect." + :type '(choice (const :tag "Let ImageMagick handle all types it can" nil) (repeat symbol)) :version "24.1" :group 'image) ;;;###autoload (defun imagemagick-register-types () - "Register the file types that ImageMagick is able to handle." - (if (fboundp 'imagemagick-types) - (let ((im-types (imagemagick-types))) - (dolist (im-inhibit imagemagick-types-inhibit) - (setq im-types (remove im-inhibit im-types))) - (dolist (im-type im-types) - (let ((extension (downcase (symbol-name im-type)))) - (push - (cons (concat "\\." extension "\\'") 'image-mode) - auto-mode-alist) - (push - (cons (concat "\\." extension "\\'") 'imagemagick) - image-type-file-name-regexps)))) - (error "Emacs was not built with ImageMagick support"))) + "Register file types that can be handled by ImageMagick. +This adds the file types returned by `imagemagick-types' +\(excluding the ones in `imagemagick-types-inhibit') to +`auto-mode-alist' and `image-type-file-name-regexps', so that +Emacs visits them in Image mode. + +If Emacs is compiled without ImageMagick support, do nothing." + (when (fboundp 'imagemagick-types) + (let ((im-types (imagemagick-types))) + (dolist (im-inhibit imagemagick-types-inhibit) + (setq im-types (delq im-inhibit im-types))) + (dolist (im-type im-types) + (let ((extension + (concat "\\." (downcase (symbol-name im-type)) + "\\'"))) + (push (cons extension 'image-mode) auto-mode-alist) + (push (cons extension 'imagemagick) + image-type-file-name-regexps)))))) (provide 'image) === modified file 'src/ChangeLog' --- src/ChangeLog 2011-05-29 05:23:24 +0000 +++ src/ChangeLog 2011-05-29 18:17:28 +0000 @@ -1,3 +1,8 @@ +2011-05-29 Chong Yidong + + * image.c: Various fixes to ImageMagick code comments. + (Fimagemagick_types): Doc fix. + 2011-05-29 Paul Eggert Minor fixes prompted by GCC 4.6.0 warnings. === modified file 'src/image.c' --- src/image.c 2011-05-15 17:17:44 +0000 +++ src/image.c 2011-05-29 18:17:28 +0000 @@ -7352,6 +7352,10 @@ Lisp_Object Qimagemagick; +static int imagemagick_image_p (Lisp_Object); +static int imagemagick_load (struct frame *, struct image *); +static void imagemagick_clear_image (struct frame *, struct image *); + /* Indices of image specification fields in imagemagick_format. */ enum imagemagick_keyword_index @@ -7394,6 +7398,18 @@ {":crop", IMAGE_DONT_CHECK_VALUE_TYPE, 0} }; +/* Structure describing the image type for any image handled via + ImageMagick. */ + +static struct image_type imagemagick_type = + { + &Qimagemagick, + imagemagick_image_p, + imagemagick_load, + imagemagick_clear_image, + NULL + }; + /* Free X resources of imagemagick image IMG which is used on frame F. */ static void @@ -7425,34 +7441,27 @@ #define DrawRectangle DrawRectangleGif #include -/* imagemagick_load_image is a helper function for imagemagick_load, - which does the actual loading given contents and size, apart from - frame and image structures, passed from imagemagick_load. - - Uses librimagemagick to do most of the image processing. - - Return non-zero if successful. -*/ +/* Helper function for imagemagick_load, which does the actual loading + given contents and size, apart from frame and image structures, + passed from imagemagick_load. Uses librimagemagick to do most of + the image processing. + + F is a pointer to the Emacs frame; IMG to the image structure to + prepare; CONTENTS is the string containing the IMAGEMAGICK data to + be parsed; SIZE is the number of bytes of data; and FILENAME is + either the file name or the image data. + + Return non-zero if successful. */ static int -imagemagick_load_image (/* Pointer to emacs frame structure. */ - struct frame *f, - /* Pointer to emacs image structure. */ - struct image *img, - /* String containing the IMAGEMAGICK data to - be parsed. */ - unsigned char *contents, - /* Size of data in bytes. */ - unsigned int size, - /* Filename, either pass filename or - contents/size. */ - unsigned char *filename) +imagemagick_load_image (struct frame *f, struct image *img, + unsigned char *contents, unsigned int size, + unsigned char *filename) { unsigned long width; unsigned long height; - MagickBooleanType - status; + MagickBooleanType status; XImagePtr ximg; Lisp_Object specified_bg; @@ -7514,8 +7523,8 @@ DestroyMagickWand (ping_wand); - /* Now, after pinging, we know how many images are inside the - file. If it's not a bundle, the number is one. */ + /* Now we know how many images are inside the file. If it's not a + bundle, the number is one. */ if (filename != NULL) { @@ -7628,8 +7637,8 @@ } } - /* Finaly we are done manipulating the image, figure out resulting - width, height, and then transfer ownerwship to Emacs. */ + /* Finally we are done manipulating the image. Figure out the + resulting width/height and transfer ownerwship to Emacs. */ height = MagickGetImageHeight (image_wand); width = MagickGetImageWidth (image_wand); @@ -7784,8 +7793,7 @@ the prototype thus needs to be compatible with that structure. */ static int -imagemagick_load (struct frame *f, - struct image *img) +imagemagick_load (struct frame *f, struct image *img) { int success_p = 0; Lisp_Object file_name; @@ -7823,36 +7831,18 @@ return success_p; } -/* Structure describing the image type `imagemagick'. Its the same - type of structure defined for all image formats, handled by Emacs - image functions. See struct image_type in dispextern.h. */ - -static struct image_type imagemagick_type = - { - /* An identifier showing that this is an image structure for the - IMAGEMAGICK format. */ - &Qimagemagick, - /* Handle to a function that can be used to identify a IMAGEMAGICK - file. */ - imagemagick_image_p, - /* Handle to function used to load a IMAGEMAGICK file. */ - imagemagick_load, - /* Handle to function to free resources for IMAGEMAGICK. */ - imagemagick_clear_image, - /* An internal field to link to the next image type in a list of - image types, will be filled in when registering the format. */ - NULL - }; - - DEFUN ("imagemagick-types", Fimagemagick_types, Simagemagick_types, 0, 0, 0, - doc: /* Return the image types supported by ImageMagick. -Note that ImageMagick recognizes many file-types that Emacs does not recognize -as images, such as .c. */) + doc: /* Return a list of image types supported by ImageMagick. +Each entry in this list is a symbol named after an ImageMagick format +tag. See the ImageMagick manual for a list of ImageMagick formats and +their descriptions (http://www.imagemagick.org/script/formats.php). + +Note that ImageMagick recognizes many file-types that Emacs does not +recognize as images, such as C. See `imagemagick-types-inhibit'. */) (void) { Lisp_Object typelist = Qnil; - unsigned long numf; + unsigned long numf = 0; ExceptionInfo ex; char **imtypes = GetMagickList ("*", &numf, &ex); int i; ------------------------------------------------------------ revno: 104421 committer: Deniz Dogan branch nick: emacs-trunk timestamp: Sun 2011-05-29 07:42:00 +0200 message: * net/rcirc.el (rcirc): Use the user's stored encryption method by default. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-29 00:45:00 +0000 +++ lisp/ChangeLog 2011-05-29 05:42:00 +0000 @@ -1,3 +1,8 @@ +2011-05-29 Deniz Dogan + + * net/rcirc.el (rcirc): Use the user's stored encryption method by + default. + 2011-05-29 Chong Yidong * select.el: Don't perform clipboard-manager saving in hooks; === modified file 'lisp/net/rcirc.el' --- lisp/net/rcirc.el 2011-05-19 12:38:39 +0000 +++ lisp/net/rcirc.el 2011-05-29 05:42:00 +0000 @@ -456,7 +456,12 @@ (encryption (intern (completing-read "Encryption (default plain): " '("plain" "tls") - nil t nil nil "plain")))) + nil t + (let ((choice (plist-get server-plist + :encryption))) + (when choice + (symbol-name choice))) + nil "plain")))) (rcirc-connect server port nick user-name rcirc-default-full-name channels password encryption)) ------------------------------------------------------------ revno: 104420 [merge] committer: Paul Eggert branch nick: trunk timestamp: Sat 2011-05-28 22:24:24 -0700 message: Merge: Minor fixes prompted by GCC 4.6.0 warnings. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-05-29 00:45:00 +0000 +++ src/ChangeLog 2011-05-29 05:23:24 +0000 @@ -1,3 +1,13 @@ +2011-05-29 Paul Eggert + + Minor fixes prompted by GCC 4.6.0 warnings. + + * xselect.c (converted_selections, conversion_fail_tag): Now static. + + * emacs.c [HAVE_X_WINDOWS]: Include "xterm.h". + (x_clipboard_manager_save_all): Move extern decl to ... + * xterm.h: ... here, so that it can be checked for consistency. + 2011-05-29 Chong Yidong * xselect.c (x_clipboard_manager_save_frame) === modified file 'src/emacs.c' --- src/emacs.c 2011-05-29 00:45:00 +0000 +++ src/emacs.c 2011-05-29 04:08:28 +0000 @@ -65,6 +65,10 @@ #include "nsterm.h" #endif +#ifdef HAVE_X_WINDOWS +#include "xterm.h" +#endif + #ifdef HAVE_SETLOCALE #include #endif @@ -1959,11 +1963,6 @@ xfree (priority); } -#ifdef HAVE_X_WINDOWS -/* Defined in xselect.c. */ -extern void x_clipboard_manager_save_all (void); -#endif - DEFUN ("kill-emacs", Fkill_emacs, Skill_emacs, 0, 1, "P", doc: /* Exit the Emacs job and kill it. If ARG is an integer, return ARG as the exit program code. === modified file 'src/xselect.c' --- src/xselect.c 2011-05-29 00:45:00 +0000 +++ src/xselect.c 2011-05-29 05:23:24 +0000 @@ -489,10 +489,10 @@ /* Linked list of the above (in support of MULTIPLE targets). */ -struct selection_data *converted_selections; +static struct selection_data *converted_selections; /* "Data" to send a requestor for a failed MULTIPLE subtarget. */ -Atom conversion_fail_tag; +static Atom conversion_fail_tag; /* Used as an unwind-protect clause so that, if a selection-converter signals an error, we tell the requester that we were unable to do what they wanted === modified file 'src/xterm.h' --- src/xterm.h 2011-05-29 00:45:00 +0000 +++ src/xterm.h 2011-05-29 04:08:28 +0000 @@ -1025,6 +1025,7 @@ int, unsigned long); extern void x_clipboard_manager_save_frame (Lisp_Object); +extern void x_clipboard_manager_save_all (void); /* Defined in xfns.c */ ------------------------------------------------------------ revno: 104419 committer: Leo Liu branch nick: trunk timestamp: Sun 2011-05-29 10:45:03 +0800 message: Add option :named to defstruct in url-cookie.el or url-cookie-p won't be defined. See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8747 for details. diff: === modified file 'lisp/url/ChangeLog' --- lisp/url/ChangeLog 2011-05-02 18:15:39 +0000 +++ lisp/url/ChangeLog 2011-05-29 02:45:03 +0000 @@ -1,3 +1,8 @@ +2011-05-29 Leo Liu + + * url-cookie.el (url-cookie): Add option :named so that + url-cookie-p is defined. (Bug#8747) + 2011-05-02 Lars Magne Ingebrigtsen * url-queue.el: New file. === modified file 'lisp/url/url-cookie.el' --- lisp/url/url-cookie.el 2011-04-01 23:24:21 +0000 +++ lisp/url/url-cookie.el 2011-05-29 02:45:03 +0000 @@ -35,17 +35,13 @@ :group 'url) ;; A cookie is stored internally as a vector of 7 slots -;; [ cookie NAME VALUE EXPIRES LOCALPART DOMAIN SECURE ] +;; [ url-cookie NAME VALUE EXPIRES LOCALPART DOMAIN SECURE ] (defstruct (url-cookie (:constructor url-cookie-create) (:copier nil) - ;; For compatibility with a previous version which did not use - ;; defstruct, and also in order to make sure that the printed - ;; representation does not depend on CL internals, we use an - ;; explicitly managed tag. - (:type vector)) - (tag 'cookie :read-only t) + (:type vector) + :named) name value expires localpart domain secure) (defvar url-cookie-storage nil "Where cookies are stored.") @@ -77,8 +73,6 @@ ;; It's completely normal for the cookies file not to exist yet. (load (or fname url-cookie-file) t t)) -(declare-function url-cookie-p "url-cookie" t t) ; defstruct - (defun url-cookie-clean-up (&optional secure) (let ((var (if secure 'url-cookie-secure-storage 'url-cookie-storage)) new new-cookies) ------------------------------------------------------------ revno: 104418 committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-05-28 20:45:00 -0400 message: Move clipboard-manager functionality out of hooks. * lisp/select.el: Don't perform clipboard-manager saving in hooks; leave the hooks empty. * src/emacs.c (Fkill_emacs): Call x_clipboard_manager_save_all. * src/frame.c (delete_frame): Call x_clipboard_manager_save_frame. * src/xselect.c (x_clipboard_manager_save_frame) (x_clipboard_manager_save_all): New functions. (Fx_clipboard_manager_save): Lisp function deleted. * src/xterm.h: Update prototype. diff: === modified file 'etc/NEWS' --- etc/NEWS 2011-05-28 22:56:14 +0000 +++ etc/NEWS 2011-05-29 00:45:00 +0000 @@ -177,6 +177,8 @@ Emacs.pane.menubar.font: Courier-12 ** On graphical displays, the mode-line no longer ends in dashes. +Also, the first dash (which does not indicate anything) is just +displayed as a space. ** On Nextstep/OSX, the menu bar can be hidden by customizing ns-auto-hide-menu-bar. @@ -386,6 +388,8 @@ *** Support for X cut buffers has been removed. +*** Support for X clipboard managers has been added. + ** New command `rectangle-number-lines', bound to `C-x r N', numbers the lines in the current rectangle. With an prefix argument, this prompts for a number to count from and for a format string. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-28 23:43:11 +0000 +++ lisp/ChangeLog 2011-05-29 00:45:00 +0000 @@ -1,3 +1,8 @@ +2011-05-29 Chong Yidong + + * select.el: Don't perform clipboard-manager saving in hooks; + leave the hooks empty. + 2011-05-28 Leo Liu * replace.el (occur-menu-map, occur-edit-mode-map): New vars. === modified file 'lisp/select.el' --- lisp/select.el 2011-05-27 16:17:59 +0000 +++ lisp/select.el 2011-05-29 00:45:00 +0000 @@ -395,10 +395,6 @@ (SAVE_TARGETS . xselect-convert-to-save-targets) (_EMACS_INTERNAL . xselect-convert-to-identity))) -(when (fboundp 'x-clipboard-manager-save) - (add-hook 'delete-frame-functions 'x-clipboard-manager-save) - (add-hook 'kill-emacs-hook 'x-clipboard-manager-save)) - (provide 'select) ;;; select.el ends here === modified file 'src/ChangeLog' --- src/ChangeLog 2011-05-28 16:56:53 +0000 +++ src/ChangeLog 2011-05-29 00:45:00 +0000 @@ -1,3 +1,14 @@ +2011-05-29 Chong Yidong + + * xselect.c (x_clipboard_manager_save_frame) + (x_clipboard_manager_save_all): New functions. + (Fx_clipboard_manager_save): Lisp function deleted. + + * emacs.c (Fkill_emacs): Call x_clipboard_manager_save_all. + * frame.c (delete_frame): Call x_clipboard_manager_save_frame. + + * xterm.h: Update prototype. + 2011-05-28 William Xu * nsterm.m (ns_term_shutdown): Synchronize user defaults before === modified file 'src/emacs.c' --- src/emacs.c 2011-05-04 14:03:16 +0000 +++ src/emacs.c 2011-05-29 00:45:00 +0000 @@ -1959,6 +1959,11 @@ xfree (priority); } +#ifdef HAVE_X_WINDOWS +/* Defined in xselect.c. */ +extern void x_clipboard_manager_save_all (void); +#endif + DEFUN ("kill-emacs", Fkill_emacs, Skill_emacs, 0, 1, "P", doc: /* Exit the Emacs job and kill it. If ARG is an integer, return ARG as the exit program code. @@ -1985,6 +1990,11 @@ UNGCPRO; +#ifdef HAVE_X_WINDOWS + /* Transfer any clipboards we own to the clipboard manager. */ + x_clipboard_manager_save_all (); +#endif + shut_down_emacs (0, 0, STRINGP (arg) ? arg : Qnil); /* If we have an auto-save list file, === modified file 'src/frame.c' --- src/frame.c 2011-05-12 20:23:33 +0000 +++ src/frame.c 2011-05-29 00:45:00 +0000 @@ -1347,7 +1347,14 @@ = Fcons (list3 (Qrun_hook_with_args, Qdelete_frame_functions, frame), pending_funcalls); else - safe_call2 (Qrun_hook_with_args, Qdelete_frame_functions, frame); + { +#ifdef HAVE_X_WINDOWS + /* Also, save clipboard to the the clipboard manager. */ + x_clipboard_manager_save_frame (frame); +#endif + + safe_call2 (Qrun_hook_with_args, Qdelete_frame_functions, frame); + } /* The hook may sometimes (indirectly) cause the frame to be deleted. */ if (! FRAME_LIVE_P (f)) === modified file 'src/xselect.c' --- src/xselect.c 2011-05-27 19:39:18 +0000 +++ src/xselect.c 2011-05-29 00:45:00 +0000 @@ -2107,6 +2107,7 @@ return (owner ? Qt : Qnil); } + /* Send the clipboard manager a SAVE_TARGETS request with a UTF8_STRING property, as described by http://www.freedesktop.org/wiki/ClipboardManager */ @@ -2126,54 +2127,53 @@ Qnil, frame); } -DEFUN ("x-clipboard-manager-save", Fx_clipboard_manager_save, - Sx_clipboard_manager_save, 0, 1, 0, - doc: /* Save the clipboard contents to the clipboard manager. -This function is intended to run from `delete-frame-functions' and -`kill-emacs-hook', to transfer clipboard data owned by Emacs to a -clipboard manager prior to deleting a frame or killing Emacs. - -FRAME specifies a frame owning a clipboard; do nothing if FRAME does -not own the clipboard, or if no clipboard manager is present. If -FRAME is nil, save all clipboard contents owned by Emacs. */) - (Lisp_Object frame) -{ - if (FRAMEP (frame)) - { - struct frame *f = XFRAME (frame); - if (FRAME_LIVE_P (f) && FRAME_X_P (f)) - { - struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); - Lisp_Object local_selection - = LOCAL_SELECTION (QCLIPBOARD, dpyinfo); - - if (!NILP (local_selection) - && EQ (frame, XCAR (XCDR (XCDR (XCDR (local_selection))))) - && XGetSelectionOwner (dpyinfo->display, - dpyinfo->Xatom_CLIPBOARD_MANAGER)) - x_clipboard_manager_save (dpyinfo, frame); - } - } - else if (NILP (frame)) - { - /* Loop through all X displays, saving owned clipboards. */ - struct x_display_info *dpyinfo; - Lisp_Object local_selection, local_frame; - for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next) - { - local_selection = LOCAL_SELECTION (QCLIPBOARD, dpyinfo); - if (NILP (local_selection) - || !XGetSelectionOwner (dpyinfo->display, - dpyinfo->Xatom_CLIPBOARD_MANAGER)) - continue; - - local_frame = XCAR (XCDR (XCDR (XCDR (local_selection)))); - if (FRAME_LIVE_P (XFRAME (local_frame))) - x_clipboard_manager_save (dpyinfo, local_frame); - } - } - - return Qnil; +/* Called from delete_frame: save any clipboard owned by FRAME to the + clipboard manager. Do nothing if FRAME does not own the clipboard, + or if no clipboard manager is present. */ + +void +x_clipboard_manager_save_frame (Lisp_Object frame) +{ + struct frame *f; + + if (FRAMEP (frame) + && (f = XFRAME (frame), FRAME_X_P (f)) + && FRAME_LIVE_P (f)) + { + struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + Lisp_Object local_selection + = LOCAL_SELECTION (QCLIPBOARD, dpyinfo); + + if (!NILP (local_selection) + && EQ (frame, XCAR (XCDR (XCDR (XCDR (local_selection))))) + && XGetSelectionOwner (dpyinfo->display, + dpyinfo->Xatom_CLIPBOARD_MANAGER)) + x_clipboard_manager_save (dpyinfo, frame); + } +} + +/* Called from Fkill_emacs: save any clipboard owned by FRAME to the + clipboard manager. Do nothing if FRAME does not own the clipboard, + or if no clipboard manager is present. */ + +void +x_clipboard_manager_save_all (void) +{ + /* Loop through all X displays, saving owned clipboards. */ + struct x_display_info *dpyinfo; + Lisp_Object local_selection, local_frame; + for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next) + { + local_selection = LOCAL_SELECTION (QCLIPBOARD, dpyinfo); + if (NILP (local_selection) + || !XGetSelectionOwner (dpyinfo->display, + dpyinfo->Xatom_CLIPBOARD_MANAGER)) + continue; + + local_frame = XCAR (XCDR (XCDR (XCDR (local_selection)))); + if (FRAME_LIVE_P (XFRAME (local_frame))) + x_clipboard_manager_save (dpyinfo, local_frame); + } } @@ -2586,7 +2586,6 @@ defsubr (&Sx_disown_selection_internal); defsubr (&Sx_selection_owner_p); defsubr (&Sx_selection_exists_p); - defsubr (&Sx_clipboard_manager_save); defsubr (&Sx_get_atom_name); defsubr (&Sx_send_client_message); === modified file 'src/xterm.h' --- src/xterm.h 2011-05-27 16:17:59 +0000 +++ src/xterm.h 2011-05-29 00:45:00 +0000 @@ -1024,6 +1024,7 @@ Atom, int, unsigned long); +extern void x_clipboard_manager_save_frame (Lisp_Object); /* Defined in xfns.c */ ------------------------------------------------------------ revno: 104417 committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-05-28 19:43:11 -0400 message: Make first mode-line dash an empty space on graphical terminals (Bug#7295). * lisp/bindings.el (help-echo): Make the initial non-indicator dash empty on graphical terminals. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-28 23:30:17 +0000 +++ lisp/ChangeLog 2011-05-28 23:43:11 +0000 @@ -12,6 +12,9 @@ 2011-05-28 Chong Yidong + * bindings.el (help-echo): Make the initial non-indicator dash + empty on graphical terminals (Bug#7295). + * files.el (auto-mode-alist): Move config rule after the in-stripping one (Bug#8547). === modified file 'lisp/bindings.el' --- lisp/bindings.el 2011-05-24 08:22:58 +0000 +++ lisp/bindings.el 2011-05-28 23:43:11 +0000 @@ -321,7 +321,9 @@ (standard-mode-line-format (list "%e" - (propertize "-" 'help-echo help-echo) + `(:eval (if (display-graphic-p) + ,(propertize " " 'help-echo help-echo) + ,(propertize "-" 'help-echo help-echo))) 'mode-line-mule-info 'mode-line-client 'mode-line-modified ------------------------------------------------------------ revno: 104416 committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-05-28 19:30:17 -0400 message: * startup.el (normal-splash-screen): Remove gratuitous mode-line setting (Bug#8740). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-28 23:07:43 +0000 +++ lisp/ChangeLog 2011-05-28 23:30:17 +0000 @@ -17,6 +17,9 @@ * newcomment.el (comment-end-skip): Doc fix (Bug#8659). + * startup.el (normal-splash-screen): Remove gratuitous mode-line + setting (Bug#8740). + 2011-05-28 Alp Aker (tiny change) * buff-menu.el (Buffer-menu-revert-function, Buffer-menu-sort) === modified file 'lisp/startup.el' --- lisp/startup.el 2011-05-28 17:47:45 +0000 +++ lisp/startup.el 2011-05-28 23:30:17 +0000 @@ -1739,9 +1739,6 @@ (erase-buffer) (setq default-directory command-line-default-directory) (set (make-local-variable 'tab-width) 8) - (if (not startup) - (set (make-local-variable 'mode-line-format) - (propertize "---- %b %-" 'face 'mode-line-buffer-id))) (if pure-space-overflow (insert pure-space-overflow-message)) ------------------------------------------------------------ revno: 104415 committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-05-28 19:07:43 -0400 message: * lisp/newcomment.el (comment-end-skip): Doc fix (Bug#8659). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-28 22:56:14 +0000 +++ lisp/ChangeLog 2011-05-28 23:07:43 +0000 @@ -15,6 +15,8 @@ * files.el (auto-mode-alist): Move config rule after the in-stripping one (Bug#8547). + * newcomment.el (comment-end-skip): Doc fix (Bug#8659). + 2011-05-28 Alp Aker (tiny change) * buff-menu.el (Buffer-menu-revert-function, Buffer-menu-sort) === modified file 'lisp/newcomment.el' --- lisp/newcomment.el 2011-05-11 16:37:03 +0000 +++ lisp/newcomment.el 2011-05-28 23:07:43 +0000 @@ -118,7 +118,7 @@ ;;;###autoload (defvar comment-end-skip nil - "Regexp to match the end of a comment plus everything up to its body.") + "Regexp to match the end of a comment plus everything back to its body.") ;;;###autoload(put 'comment-end-skip 'safe-local-variable 'string-or-null-p) ;;;###autoload ------------------------------------------------------------ revno: 104414 author: Leo Liu committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-05-28 18:56:14 -0400 message: New major mode: Occur Edit mode. * lisp/replace.el (occur-menu-map, occur-edit-mode-map): New vars. (occur-mode-map): Bind occur-edit-mode. Use occur-menu-map. (occur-edit-mode): New major mode (Bug#8463). (occur-after-change-function): New function. (occur-engine): Give Occur tags a read-only property. diff: === modified file 'etc/NEWS' --- etc/NEWS 2011-05-27 01:00:53 +0000 +++ etc/NEWS 2011-05-28 22:56:14 +0000 @@ -747,6 +747,9 @@ * New Modes and Packages in Emacs 24.1 +** Occur Edit mode applies edits made in *Occur* buffers to the +original buffers. It is bound to C-x C-q in Occur mode. + ** New global minor modes electric-pair-mode, electric-indent-mode, and electric-layout-mode. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-28 20:08:05 +0000 +++ lisp/ChangeLog 2011-05-28 22:56:14 +0000 @@ -1,3 +1,11 @@ +2011-05-28 Leo Liu + + * replace.el (occur-menu-map, occur-edit-mode-map): New vars. + (occur-mode-map): Bind occur-edit-mode. Use occur-menu-map. + (occur-edit-mode): New major mode (Bug#8463). + (occur-after-change-function): New function. + (occur-engine): Give Occur tags a read-only property. + 2011-05-28 Kevin Ryde * subr.el (def-edebug-spec): Doc fix (Bug#8430). === modified file 'lisp/replace.el' --- lisp/replace.el 2011-04-19 13:44:55 +0000 +++ lisp/replace.el 2011-05-28 22:56:14 +0000 @@ -761,22 +761,8 @@ count))) -(defvar occur-mode-map +(defvar occur-menu-map (let ((map (make-sparse-keymap))) - ;; We use this alternative name, so we can use \\[occur-mode-mouse-goto]. - (define-key map [mouse-2] 'occur-mode-mouse-goto) - (define-key map "\C-c\C-c" 'occur-mode-goto-occurrence) - (define-key map "\C-m" 'occur-mode-goto-occurrence) - (define-key map "o" 'occur-mode-goto-occurrence-other-window) - (define-key map "\C-o" 'occur-mode-display-occurrence) - (define-key map "\M-n" 'occur-next) - (define-key map "\M-p" 'occur-prev) - (define-key map "r" 'occur-rename-buffer) - (define-key map "c" 'clone-buffer) - (define-key map "\C-c\C-f" 'next-error-follow-minor-mode) - (define-key map [menu-bar] (make-sparse-keymap)) - (define-key map [menu-bar occur] - (cons (purecopy "Occur") map)) (define-key map [next-error-follow-minor-mode] `(menu-item ,(purecopy "Auto Occurrence Display") next-error-follow-minor-mode @@ -817,6 +803,24 @@ `(menu-item ,(purecopy "Move to Previous Match") occur-prev :help ,(purecopy "Move to the Nth (default 1) previous match in an Occur mode buffer"))) map) + "Menu keymap for `occur-mode'.") + +(defvar occur-mode-map + (let ((map (make-sparse-keymap))) + ;; We use this alternative name, so we can use \\[occur-mode-mouse-goto]. + (define-key map [mouse-2] 'occur-mode-mouse-goto) + (define-key map "\C-c\C-c" 'occur-mode-goto-occurrence) + (define-key map "\C-x\C-q" 'occur-edit-mode) + (define-key map "\C-m" 'occur-mode-goto-occurrence) + (define-key map "o" 'occur-mode-goto-occurrence-other-window) + (define-key map "\C-o" 'occur-mode-display-occurrence) + (define-key map "\M-n" 'occur-next) + (define-key map "\M-p" 'occur-prev) + (define-key map "r" 'occur-rename-buffer) + (define-key map "c" 'clone-buffer) + (define-key map "\C-c\C-f" 'next-error-follow-minor-mode) + (define-key map [menu-bar occur] (cons (purecopy "Occur") occur-menu-map)) + map) "Keymap for `occur-mode'.") (defvar occur-revert-arguments nil @@ -853,6 +857,63 @@ (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) (setq next-error-function 'occur-next-error)) + +;;; Occur Edit mode + +(defvar occur-edit-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map text-mode-map) + (define-key map [mouse-2] 'occur-mode-mouse-goto) + (define-key map "\C-c\C-c" 'occur-mode-goto-occurrence) + (define-key map "\C-x\C-q" 'occur-mode) + (define-key map "\C-c\C-f" 'next-error-follow-minor-mode) + (define-key map [menu-bar occur] (cons (purecopy "Occur") occur-menu-map)) + map) + "Keymap for `occur-edit-mode'.") + +(define-derived-mode occur-edit-mode occur-mode "Occur-Edit" + "Major mode for editing *Occur* buffers. +In this mode, changes to the *Occur* buffer are also applied to +the originating buffer. + +To return to ordinary Occur mode, use \\[occur-mode]." + (setq buffer-read-only nil) + (add-hook 'after-change-functions 'occur-after-change-function nil t)) + +(defun occur-after-change-function (beg end length) + (save-excursion + (goto-char beg) + (let* ((m (get-text-property (line-beginning-position) 'occur-target)) + (buf (marker-buffer m)) + (col (current-column))) + (when (= length 0) + ;; Apply occur-target property to inserted (e.g. yanked) text. + (put-text-property beg end 'occur-target m) + ;; Did we insert a newline? Occur Edit mode can't create new + ;; Occur entries; just discard everything after the newline. + (save-excursion + (and (search-forward "\n" end t) + (delete-region (1- (point)) end)))) + (let ((line (- (line-number-at-pos) + (line-number-at-pos (window-start)))) + (readonly (with-current-buffer buf buffer-read-only)) + (win (or (get-buffer-window buf) + (display-buffer buf t))) + (text (save-excursion + (forward-line 0) + (search-forward ":" nil t) + (setq col (- col (current-column))) + (buffer-substring-no-properties (point) (line-end-position))))) + (with-selected-window win + (goto-char m) + (recenter line) + (if readonly + (message "Buffer `%s' is read only." buf) + (delete-region (line-beginning-position) (line-end-position)) + (insert text)) + (move-to-column col)))))) + + (defun occur-revert-function (_ignore1 _ignore2) "Handle `revert-buffer' for Occur mode buffers." (apply 'occur-1 (append occur-revert-arguments (list (buffer-name))))) @@ -1280,6 +1341,7 @@ `(font-lock-face prefix-face)) `(occur-prefix t mouse-face (highlight) occur-target ,marker follow-link t + read-only t help-echo "mouse-2: go to this occurrence")))) (match-str ;; We don't put `mouse-face' on the newline, @@ -1339,13 +1401,15 @@ (goto-char headerpt) (let ((beg (point)) end) - (insert (format "%d match%s%s in buffer: %s\n" - matches (if (= matches 1) "" "es") - ;; Don't display regexp for multi-buffer. - (if (> (length buffers) 1) - "" (format " for \"%s\"" - (query-replace-descr regexp))) - (buffer-name buf))) + (insert (propertize + (format "%d match%s%s in buffer: %s\n" + matches (if (= matches 1) "" "es") + ;; Don't display regexp for multi-buffer. + (if (> (length buffers) 1) + "" (format " for \"%s\"" + (query-replace-descr regexp))) + (buffer-name buf)) + 'read-only t)) (setq end (point)) (add-text-properties beg end (append ------------------------------------------------------------ revno: 104413 author: Alp Aker committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-05-28 16:08:05 -0400 message: Additional minor fix to (Bug#8539). * lisp/buff-menu.el (Buffer-menu-buffer+size): Use Buffer-menu-buffer-column. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-28 19:36:02 +0000 +++ lisp/ChangeLog 2011-05-28 20:08:05 +0000 @@ -9,8 +9,9 @@ 2011-05-28 Alp Aker (tiny change) - * buff-menu.el (Buffer-menu-revert-function, Buffer-menu-sort): - Use Buffer-menu-buffer-column (Bug#8539). + * buff-menu.el (Buffer-menu-revert-function, Buffer-menu-sort) + (Buffer-menu-buffer+size): Use Buffer-menu-buffer-column + (Bug#8539). 2011-05-28 Chong Yidong === modified file 'lisp/buff-menu.el' --- lisp/buff-menu.el 2011-05-28 19:13:00 +0000 +++ lisp/buff-menu.el 2011-05-28 20:08:05 +0000 @@ -688,7 +688,9 @@ (concat name (propertize (make-string (- name+space-width (string-width name)) ?\s) - 'display `(space :align-to ,(+ 4 name+space-width))) + 'display `(space :align-to + ,(+ Buffer-menu-buffer-column + name+space-width))) size))) (defun Buffer-menu-sort (column) ------------------------------------------------------------ revno: 104412 committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-05-28 15:58:43 -0400 message: * doc/lispref/minibuf.texi (Reading File Names): Clarify (Bug#8480). diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2011-05-28 19:05:36 +0000 +++ doc/lispref/ChangeLog 2011-05-28 19:58:43 +0000 @@ -1,5 +1,7 @@ 2011-05-28 Chong Yidong + * minibuf.texi (Reading File Names): Clarify (Bug#8480). + * tips.texi (Coding Conventions): Remove antediluvian filename limit recommendation (Bug#8538). === modified file 'doc/lispref/minibuf.texi' --- doc/lispref/minibuf.texi 2011-05-10 13:57:12 +0000 +++ doc/lispref/minibuf.texi 2011-05-28 19:58:43 +0000 @@ -1383,17 +1383,19 @@ graphical file dialog is platform-dependent. Here, we simply document the behavior when using the minibuffer. +@code{read-file-name} does not automatically expand the returned file +name. You must call @code{expand-file-name} yourself if an absolute +file name is required. + The optional argument @var{require-match} has the same meaning as in -@code{completing-read}. @xref{Minibuffer Completion}. - -@code{read-file-name} uses -@code{minibuffer-local-filename-completion-map} as the keymap if -@var{require-match} is @code{nil}, and uses -@code{minibuffer-local-filename-must-match-map} if @var{require-match} -is non-@code{nil}. @xref{Completion Commands}. +@code{completing-read}. @xref{Minibuffer Completion}. If +@var{require-match} is @code{nil}, the local keymap in the minibuffer +is @code{minibuffer-local-filename-completion-map}; otherwise, it is +@code{minibuffer-local-filename-must-match-map}. @xref{Completion +Commands}. The argument @var{directory} specifies the directory to use for -completion of relative file names. It should be an absolute directory +completing relative file names. It should be an absolute directory name. If @code{insert-default-directory} is non-@code{nil}, @var{directory} is also inserted in the minibuffer as initial input. It defaults to the current buffer's value of @code{default-directory}. @@ -1441,11 +1443,7 @@ possibilities. A file name is an acceptable value if @var{predicate} returns non-@code{nil} for it. -@code{read-file-name} does not automatically expand file names. You -must call @code{expand-file-name} yourself if an absolute file name is -required. - -Here is an example: +Here is an example of using @code{read-file-name}: @example @group ------------------------------------------------------------ revno: 104411 author: Kevin Ryde committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-05-28 15:36:02 -0400 message: * lisp/subr.el (def-edebug-spec): Doc fix (Bug#8430). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-28 19:26:25 +0000 +++ lisp/ChangeLog 2011-05-28 19:36:02 +0000 @@ -1,3 +1,7 @@ +2011-05-28 Kevin Ryde + + * subr.el (def-edebug-spec): Doc fix (Bug#8430). + 2011-05-28 Chong Yidong * files.el (auto-mode-alist): Move config rule after the === modified file 'lisp/subr.el' --- lisp/subr.el 2011-04-28 19:35:20 +0000 +++ lisp/subr.el 2011-05-28 19:36:02 +0000 @@ -92,7 +92,7 @@ 0 (instrument no arguments); t (instrument all arguments); a symbol (naming a function with an Edebug specification); or a list. The elements of the list describe the argument types; see -\(info \"(elisp)Specification List\") for details." +Info node `(elisp)Specification List' for details." `(put (quote ,symbol) 'edebug-form-spec (quote ,spec))) (defmacro lambda (&rest cdr) ------------------------------------------------------------ revno: 104410 committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-05-28 15:26:25 -0400 message: Tweak auto-mode-alist to handle config.h.in (Bug#8547). * lisp/files.el (auto-mode-alist): Move config rule after the in-stripping one. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-28 19:13:00 +0000 +++ lisp/ChangeLog 2011-05-28 19:26:25 +0000 @@ -1,3 +1,8 @@ +2011-05-28 Chong Yidong + + * files.el (auto-mode-alist): Move config rule after the + in-stripping one (Bug#8547). + 2011-05-28 Alp Aker (tiny change) * buff-menu.el (Buffer-menu-revert-function, Buffer-menu-sort): === modified file 'lisp/files.el' --- lisp/files.el 2011-05-27 19:33:48 +0000 +++ lisp/files.el 2011-05-28 19:26:25 +0000 @@ -2437,8 +2437,6 @@ ("\\.ppd\\'" . conf-ppd-mode) ("java.+\\.conf\\'" . conf-javaprop-mode) ("\\.properties\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-javaprop-mode) - ;; *.cf, *.cfg, *.conf, *.config[.local|.de_DE.UTF8|...], */config - ("[/.]c\\(?:on\\)?f\\(?:i?g\\)?\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-mode-maybe) ("\\`/etc/\\(?:DIR_COLORS\\|ethers\\|.?fstab\\|.*hosts\\|lesskey\\|login\\.?de\\(?:fs\\|vperm\\)\\|magic\\|mtab\\|pam\\.d/.*\\|permissions\\(?:\\.d/.+\\)?\\|protocols\\|rpc\\|services\\)\\'" . conf-space-mode) ("\\`/etc/\\(?:acpid?/.+\\|aliases\\(?:\\.d/.+\\)?\\|default/.+\\|group-?\\|hosts\\..+\\|inittab\\|ksysguarddrc\\|opera6rc\\|passwd-?\\|shadow-?\\|sysconfig/.+\\)\\'" . conf-mode) ;; ChangeLog.old etc. Other change-log-mode entries are above; @@ -2460,11 +2458,14 @@ ;; Using mode nil rather than `ignore' would let the search continue ;; through this list (with the shortened name) rather than start over. ("\\.~?[0-9]+\\.[0-9][-.0-9]*~?\\'" nil t) + ("\\.\\(?:orig\\|in\\|[bB][aA][kK]\\)\\'" nil t) + ;; This should come after "in" stripping (e.g. config.h.in). + ;; *.cf, *.cfg, *.conf, *.config[.local|.de_DE.UTF8|...], */config + ("[/.]c\\(?:on\\)?f\\(?:i?g\\)?\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-mode-maybe) ;; The following should come after the ChangeLog pattern ;; for the sake of ChangeLog.1, etc. ;; and after the .scm.[0-9] and CVS' . patterns too. - ("\\.[1-9]\\'" . nroff-mode) - ("\\.\\(?:orig\\|in\\|[bB][aA][kK]\\)\\'" nil t))) + ("\\.[1-9]\\'" . nroff-mode))) "Alist of filename patterns vs corresponding major mode functions. Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL). \(NON-NIL stands for anything that is not nil; the value does not matter.) ------------------------------------------------------------ revno: 104409 author: Alp Aker committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-05-28 15:13:00 -0400 message: Use Buffer-menu-buffer-column to replace hard-coded values (Bug#8539). * lisp/buff-menu.el (Buffer-menu-revert-function, Buffer-menu-sort): Use Buffer-menu-buffer-column. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-28 18:48:41 +0000 +++ lisp/ChangeLog 2011-05-28 19:13:00 +0000 @@ -1,5 +1,11 @@ +2011-05-28 Alp Aker (tiny change) + + * buff-menu.el (Buffer-menu-revert-function, Buffer-menu-sort): + Use Buffer-menu-buffer-column (Bug#8539). + 2011-05-28 Chong Yidong + * emacs-lisp/re-builder.el (re-builder): Improve doc (Bug#8286). 2011-05-28 Dima Kogan (tiny change) === modified file 'lisp/buff-menu.el' --- lisp/buff-menu.el 2011-04-23 03:07:16 +0000 +++ lisp/buff-menu.el 2011-05-28 19:13:00 +0000 @@ -278,7 +278,7 @@ (let ((opoint (point)) (eobp (eobp)) (ocol (current-column)) - (oline (progn (move-to-column 4) + (oline (progn (move-to-column Buffer-menu-buffer-column) (get-text-property (point) 'buffer))) (prop (point-min)) ;; do not make undo records for the reversion. @@ -703,7 +703,11 @@ (save-excursion (Buffer-menu-beginning) (while (not (eobp)) - (when (buffer-live-p (setq buf (get-text-property (+ (point) 4) 'buffer))) + (when (buffer-live-p + (setq buf (get-text-property + (+ (point) + Buffer-menu-buffer-column) + 'buffer))) (setq m1 (char-after) m1 (if (memq m1 '(?> ?D)) m1) m2 (char-after (+ (point) 2)) @@ -715,7 +719,9 @@ (save-excursion (Buffer-menu-beginning) (while (not (eobp)) - (when (setq buf (assq (get-text-property (+ (point) 4) 'buffer) l)) + (when (setq buf (assq (get-text-property (+ (point) + Buffer-menu-buffer-column) + 'buffer) l)) (setq m1 (cadr buf) m2 (cadr (cdr buf))) (when m1 ------------------------------------------------------------ revno: 104408 committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-05-28 15:05:36 -0400 message: Remove antediluvian filename limit recommendation from tips.texi (Bug#8538). * doc/lispref/tips.texi (Coding Conventions): Remove antediluvian filename limit recommendation. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2011-05-27 01:00:53 +0000 +++ doc/lispref/ChangeLog 2011-05-28 19:05:36 +0000 @@ -1,3 +1,8 @@ +2011-05-28 Chong Yidong + + * tips.texi (Coding Conventions): Remove antediluvian filename + limit recommendation (Bug#8538). + 2011-05-27 Glenn Morris * modes.texi (Auto Major Mode): Update for set-auto-mode changes. === modified file 'doc/lispref/tips.texi' --- doc/lispref/tips.texi 2011-01-25 04:08:28 +0000 +++ doc/lispref/tips.texi 2011-05-28 19:05:36 +0000 @@ -204,12 +204,6 @@ itself, since that would confuse these tools. @item -Please keep the names of your Emacs Lisp source files to 13 characters -or less. This way, if the files are compiled, the compiled files' names -will be 14 characters or less, which is short enough to fit on all kinds -of Unix systems. - -@item In some other systems there is a convention of choosing variable names that begin and end with @samp{*}. We don't use that convention in Emacs Lisp, so please don't use it in your programs. (Emacs uses such names ------------------------------------------------------------ revno: 104407 committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-05-28 14:48:41 -0400 message: * emacs-lisp/re-builder.el (re-builder): Improve doc (Bug#8286). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-28 18:35:29 +0000 +++ lisp/ChangeLog 2011-05-28 18:48:41 +0000 @@ -1,3 +1,7 @@ +2011-05-28 Chong Yidong + + * emacs-lisp/re-builder.el (re-builder): Improve doc (Bug#8286). + 2011-05-28 Dima Kogan (tiny change) * progmodes/hideshow.el (hs-looking-at-block-start-p): New fun. === modified file 'lisp/emacs-lisp/re-builder.el' --- lisp/emacs-lisp/re-builder.el 2011-04-04 09:35:16 +0000 +++ lisp/emacs-lisp/re-builder.el 2011-05-28 18:48:41 +0000 @@ -351,9 +351,14 @@ ;;;###autoload (defun re-builder () - "Construct a regexp interactively." + "Construct a regexp interactively. +This command makes the current buffer the \"target\" buffer of +the regexp builder. It displays a buffer named \"*RE-Builder*\" +in another window, initially containing an empty regexp. + +As you edit the regexp in the \"*RE-Builder*\" buffer, the +matching parts of the target buffer will be highlighted." (interactive) - (if (and (string= (buffer-name) reb-buffer) (reb-mode-buffer-p)) (message "Already in the RE Builder") ------------------------------------------------------------ revno: 104406 author: Dima Kogan committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-05-28 14:35:29 -0400 message: More fixes to prevent hide-show from being confused by commented-out braces (Bug#8279). * progmodes/hideshow.el (hs-looking-at-block-start-p): New fun. (hs-hide-block-at-point, hs-find-block-beginning) (hs-already-hidden-p, hs-hide-block, hs-show-block): Use it. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-28 17:47:45 +0000 +++ lisp/ChangeLog 2011-05-28 18:35:29 +0000 @@ -1,3 +1,10 @@ +2011-05-28 Dima Kogan (tiny change) + + * progmodes/hideshow.el (hs-looking-at-block-start-p): New fun. + (hs-hide-block-at-point, hs-find-block-beginning) + (hs-already-hidden-p, hs-hide-block, hs-show-block): Use it + (Bug#8279). + 2011-05-28 Glenn Morris * startup.el (fancy-about-screen): Use standard mode line. (Bug#8740) === modified file 'lisp/progmodes/hideshow.el' --- lisp/progmodes/hideshow.el 2011-04-22 18:44:26 +0000 +++ lisp/progmodes/hideshow.el 2011-05-28 18:35:29 +0000 @@ -536,6 +536,11 @@ (overlay-put ov 'display nil)))) (overlay-put ov 'invisible (and hide-p 'hs))) +(defun hs-looking-at-block-start-p () + "Return non-nil if the point is at the block start." + (and (looking-at hs-block-start-regexp) + (save-match-data (not (nth 4 (syntax-ppss)))))) + (defun hs-forward-sexp (match-data arg) "Adjust point based on MATCH-DATA and call `hs-forward-sexp-func' w/ ARG. Original match data is restored upon return." @@ -564,7 +569,7 @@ and then further adjusted to be at the end of the line." (if comment-reg (hs-hide-comment-region (car comment-reg) (cadr comment-reg) end) - (when (looking-at hs-block-start-regexp) + (when (hs-looking-at-block-start-p) (let ((mdata (match-data t)) (header-end (match-end 0)) p q ov) @@ -684,16 +689,16 @@ (let ((done nil) (here (point))) ;; look if current line is block start - (if (looking-at hs-block-start-regexp) + (if (hs-looking-at-block-start-p) (point) ;; look backward for the start of a block that contains the cursor (while (and (re-search-backward hs-block-start-regexp nil t) - (save-match-data - (not (nth 4 (syntax-ppss)))) ; not inside comments - (not (setq done - (< here (save-excursion - (hs-forward-sexp (match-data t) 1) - (point))))))) + ;; go again if in a comment + (or (save-match-data (nth 4 (syntax-ppss))) + (not (setq done + (< here (save-excursion + (hs-forward-sexp (match-data t) 1) + (point)))))))) (if done (point) (goto-char here) @@ -750,7 +755,7 @@ (end-of-line) (when (and (not c-reg) (hs-find-block-beginning) - (looking-at hs-block-start-regexp)) + (hs-looking-at-block-start-p)) ;; point is inside a block (goto-char (match-end 0))))) (end-of-line) @@ -835,7 +840,7 @@ (<= (count-lines (car c-reg) (nth 1 c-reg)) 1))) (message "(not enough comment lines to hide)")) ((or c-reg - (looking-at hs-block-start-regexp) + (hs-looking-at-block-start-p) (hs-find-block-beginning)) (hs-hide-block-at-point end c-reg) (run-hooks 'hs-hide-hook)))))) @@ -867,7 +872,7 @@ q (cadr c-reg)))) ((and (hs-find-block-beginning) ;; ugh, fresh match-data - (looking-at hs-block-start-regexp)) + (hs-looking-at-block-start-p)) (setq p (point) q (progn (hs-forward-sexp (match-data t) 1) (point))))) (when (and p q) ------------------------------------------------------------ revno: 104405 committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-05-28 14:22:08 -0400 message: Document prog-mode-hook in Emacs manual. * custom.texi (Hooks): Reorganize. Mention Prog mode. * fixit.texi (Spelling): Mention using prog-mode-hook for flypsell prog mode (Bug#8240). diff: === modified file 'doc/emacs/ChangeLog' --- doc/emacs/ChangeLog 2011-05-27 01:00:53 +0000 +++ doc/emacs/ChangeLog 2011-05-28 18:22:08 +0000 @@ -1,3 +1,10 @@ +2011-05-28 Chong Yidong + + * custom.texi (Hooks): Reorganize. Mention Prog mode. + + * fixit.texi (Spelling): Mention using prog-mode-hook for flypsell + prog mode (Bug#8240). + 2011-05-27 Glenn Morris * custom.texi (Specifying File Variables): === modified file 'doc/emacs/custom.texi' --- doc/emacs/custom.texi 2011-05-27 01:00:53 +0000 +++ doc/emacs/custom.texi 2011-05-28 18:22:08 +0000 @@ -888,53 +888,48 @@ hook is a Lisp variable which holds a list of functions, to be called on some well-defined occasion. (This is called @dfn{running the hook}.) The individual functions in the list are called the @dfn{hook -functions} of the hook. With rare exceptions, hooks in Emacs are -empty when Emacs starts up, so the only hook functions in any given -hook are the ones you explicitly put there as customization. - - Most major modes run one or more @dfn{mode hooks} as the last step -of initialization. This makes it easy for you to customize the -behavior of the mode, by setting up a hook function to override the -local variable assignments already made by the mode. But hooks are -also used in other contexts. For example, the hook -@code{kill-emacs-hook} runs just before quitting the Emacs job -(@pxref{Exiting}). +functions} of the hook. For example, the hook @code{kill-emacs-hook} +runs just before exiting Emacs (@pxref{Exiting}). @cindex normal hook - Most Emacs hooks are @dfn{normal hooks}. This means that running the -hook operates by calling all the hook functions, unconditionally, with -no arguments. We have made an effort to keep most hooks normal so that -you can use them in a uniform way. Every variable in Emacs whose name -ends in @samp{-hook} is a normal hook. + Most hooks are @dfn{normal hooks}. This means that when Emacs runs +the hook, it calls each hook function in turn, with no arguments. We +have made an effort to keep most hooks normal, so that you can use +them in a uniform way. Every variable whose name ends in @samp{-hook} +is a normal hook. @cindex abnormal hook - There are also a few @dfn{abnormal hooks}. These variables' names end -in @samp{-hooks} or @samp{-functions}, instead of @samp{-hook}. What -makes these hooks abnormal is that there is something peculiar about the -way its functions are called---perhaps they are given arguments, or -perhaps the values they return are used in some way. For example, -@code{find-file-not-found-functions} (@pxref{Visiting}) is abnormal because -as soon as one hook function returns a non-@code{nil} value, the rest -are not called at all. The documentation of each abnormal hook variable -explains in detail what is peculiar about it. + A few hooks are @dfn{abnormal hooks}. Their names end in +@samp{-hooks} or @samp{-functions}, instead of @samp{-hook}. What +makes these hooks abnormal is the way its functions are +called---perhaps they are given arguments, or perhaps the values they +return are used in some way. For example, +@code{find-file-not-found-functions} is abnormal because as soon as +one hook function returns a non-@code{nil} value, the rest are not +called at all (@pxref{Visiting}). The documentation of each abnormal +hook variable explains how its functions are used. @findex add-hook You can set a hook variable with @code{setq} like any other Lisp -variable, but the recommended way to add a hook function to a hook -(either normal or abnormal) is by calling @code{add-hook}. -@xref{Hooks,,, elisp, The Emacs Lisp Reference Manual}. +variable, but the recommended way to add a function to a hook (either +normal or abnormal) is to use @code{add-hook}, as shown by the +following examples. @xref{Hooks,,, elisp, The Emacs Lisp Reference +Manual}, for details. - For example, here's how to set up a hook to turn on Auto Fill mode -when entering Text mode and other modes based on Text mode: + Most major modes run one or more @dfn{mode hooks} as the last step +of initialization. Mode hooks are a convenient way to customize the +behavior of individual modes; they are always normal. For example, +here's how to set up a hook to turn on Auto Fill mode when entering +Text mode and other modes based on Text mode: @example (add-hook 'text-mode-hook 'turn-on-auto-fill) @end example - The next example shows how to use a hook to customize the indentation -of C code. (People often have strong personal preferences for one -format compared to another.) Here the hook function is an anonymous -lambda expression. + Here is another example, showing how to use a hook to customize the +indentation of C code. The hook function uses an anonymous lambda +expression (@pxref{Lambda Expressions,,, elisp, The Emacs Lisp +Reference Manual}). @example @group @@ -944,24 +939,32 @@ @group (c-cleanup-list . (scope-operator empty-defun-braces - defun-close-semi)) -@end group -@group - (c-offsets-alist . ((arglist-close . c-lineup-arglist) - (substatement-open . 0))))) + defun-close-semi)))) @end group @group (add-hook 'c-mode-common-hook - '(lambda () - (c-add-style "my-style" my-c-style t))) + (lambda () (c-add-style "my-style" my-c-style t))) @end group @end example +@cindex Prog mode +@cindex program editing + Major mode hooks also apply to other major modes @dfn{derived} from +the original mode (@pxref{Derived Modes,,, elisp, The Emacs Lisp +Reference Manual}). For instance, HTML mode (@pxref{HTML Mode}) +inherits from Text mode; when HTML mode is enabled, it runs +@code{text-mode-hook} before running @code{html-mode-hook}. This +provides a convenient way to use a single hook to affect several +related modes. In particular, if you want to apply a hook function to +any programming language mode, add it to @code{prog-mode-hook}; Prog +mode is a major mode that does little else than to let other major +modes inherit from it, exactly for this purpose. + It is best to design your hook functions so that the order in which they are executed does not matter. Any dependence on the order is -``asking for trouble.'' However, the order is predictable: the most -recently added hook functions are executed first. +asking for trouble. However, the order is predictable: the hook +functions are executed in the order they appear in the hook. @findex remove-hook If you play with adding various different versions of a hook === modified file 'doc/emacs/fixit.texi' --- doc/emacs/fixit.texi 2011-05-17 02:26:56 +0000 +++ doc/emacs/fixit.texi 2011-05-28 18:22:08 +0000 @@ -400,17 +400,16 @@ @cindex Flyspell mode @findex flyspell-mode +@findex turn-on-flyspell Flyspell mode is a fully-automatic way to check spelling as you edit in Emacs. It operates by checking words as you change or insert them. When it finds a word that it does not recognize, it highlights that word. This does not interfere with your editing, but when you see the highlighted word, you can move to it and fix it. Type @kbd{M-x flyspell-mode} to enable or disable this mode in the current buffer. -@findex turn-on-flyspell -To enable @code{flyspell-mode} in all text mode buffers, add +To enable Flyspell mode in all text mode buffers, add @code{turn-on-flyspell} to @code{text-mode-hook}. - When Flyspell mode highlights a word as misspelled, you can click on it with @kbd{Mouse-2} to display a menu of possible corrections and actions. You can also correct the word by editing it manually in any @@ -421,4 +420,5 @@ that it only checks words in comments and string constants. This feature is useful for editing programs. Type @kbd{M-x flyspell-prog-mode} to enable or disable this mode in the current -buffer. +buffer. To enable this mode in all programming mode buffers, add +@code{flyspell-prog-mode} to @code{prog-mode-hook} (@pxref{Hooks}). ------------------------------------------------------------ revno: 104404 committer: Glenn Morris branch nick: trunk timestamp: Sat 2011-05-28 10:47:45 -0700 message: * lisp/startup.el (fancy-about-screen): Use standard mode line. (Bug#8740) diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-28 17:40:37 +0000 +++ lisp/ChangeLog 2011-05-28 17:47:45 +0000 @@ -1,3 +1,7 @@ +2011-05-28 Glenn Morris + + * startup.el (fancy-about-screen): Use standard mode line. (Bug#8740) + 2011-05-28 Chong Yidong * help-fns.el (describe-function-1): If the function is a derived === modified file 'lisp/startup.el' --- lisp/startup.el 2011-04-28 22:58:40 +0000 +++ lisp/startup.el 2011-05-28 17:47:45 +0000 @@ -1676,11 +1676,7 @@ (save-selected-window (select-frame frame) (switch-to-buffer "*About GNU Emacs*") - (setq buffer-undo-list t - mode-line-format - (concat "----" - (propertize "%b" 'face 'mode-line-buffer-id) - "%-")) + (setq buffer-undo-list t) (let ((inhibit-read-only t)) (erase-buffer) (if pure-space-overflow ------------------------------------------------------------ revno: 104403 committer: Glenn Morris branch nick: trunk timestamp: Sat 2011-05-28 10:46:02 -0700 message: * admin/notes/bzr: Your very own Loggerhead server. diff: === modified file 'admin/notes/bzr' --- admin/notes/bzr 2011-05-14 19:09:37 +0000 +++ admin/notes/bzr 2011-05-28 17:46:02 +0000 @@ -179,3 +179,24 @@ You could also try `bzr add --file-ids-from', if you have a copy of another branch where file still exists. + +* Loggerhead + +Loggerhead is the bzr tool for viewing a repository over http (similar +to ViewVC). The central version is at http://bzr.savannah.gnu.org/lh/emacs, +but if you just like the way this interface presents data, then if +you have your own copy of the repository, you can operate your own +Loggerhead server in stand-alone mode, and so help to reduce the load +on Savannah: + + bzr branch lp:loggerhead ~/.bazaar/plugins/loggerhead + cd /path/to/emacs/bzr + bzr serve --http + +You may need to install some Python dependencies to get this command to work. +For example, on RHEL6 I needed: + + yum install python-paste python-simplejson + yum --enablerepo=epel install python-simpletal + +Then point your web-browser to http://127.0.0.1:8080/ . ------------------------------------------------------------ revno: 104402 committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-05-28 13:40:37 -0400 message: In describe-function, print the parent of a derived mode. * lisp/help-fns.el (describe-function-1): If the function is a derived major mode, print the parent mode. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-28 17:16:54 +0000 +++ lisp/ChangeLog 2011-05-28 17:40:37 +0000 @@ -1,5 +1,8 @@ 2011-05-28 Chong Yidong + * help-fns.el (describe-function-1): If the function is a derived + major mode, print the parent mode. + * progmodes/cc-mode.el (c-mode, c++-mode, objc-mode, java-mode) (idl-mode, pike-mode, awk-mode): Inherit from prog-mode. === modified file 'lisp/help-fns.el' --- lisp/help-fns.el 2011-04-13 17:56:47 +0000 +++ lisp/help-fns.el 2011-05-28 17:40:37 +0000 @@ -557,6 +557,21 @@ (insert (car high) "\n") (fill-region fill-begin (point))) (setq doc (cdr high)))) + + ;; If this is a derived mode, link to the parent. + (let ((parent-mode (and (symbolp real-function) + (get real-function + 'derived-mode-parent)))) + (when parent-mode + (with-current-buffer standard-output + (insert "\nParent mode: `") + (let ((beg (point))) + (insert (format "%s" parent-mode)) + (make-text-button beg (point) + 'type 'help-function + 'help-args (list parent-mode)))) + (princ "'.\n"))) + (let* ((obsolete (and ;; function might be a lambda construct. (symbolp function) ------------------------------------------------------------ revno: 104401 committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-05-28 13:16:54 -0400 message: Make CC modes inherit from prog-mode. * lisp/progmodes/cc-mode.el (c-mode, c++-mode, objc-mode, java-mode) (idl-mode, pike-mode, awk-mode): Inherit from prog-mode. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-28 02:10:32 +0000 +++ lisp/ChangeLog 2011-05-28 17:16:54 +0000 @@ -1,3 +1,8 @@ +2011-05-28 Chong Yidong + + * progmodes/cc-mode.el (c-mode, c++-mode, objc-mode, java-mode) + (idl-mode, pike-mode, awk-mode): Inherit from prog-mode. + 2011-05-28 Stefan Monnier * minibuffer.el (completion--capf-wrapper): Check applicability before === modified file 'lisp/progmodes/cc-mode.el' --- lisp/progmodes/cc-mode.el 2011-01-25 04:08:28 +0000 +++ lisp/progmodes/cc-mode.el 2011-05-28 17:16:54 +0000 @@ -1174,7 +1174,7 @@ ;;;###autoload -(defun c-mode () +(define-derived-mode c-mode prog-mode "C" "Major mode for editing K&R and ANSI C code. To submit a problem report, enter `\\[c-submit-bug-report]' from a c-mode buffer. This automatically sets up a mail buffer with version @@ -1188,13 +1188,9 @@ Key bindings: \\{c-mode-map}" - (interactive) - (kill-all-local-variables) (c-initialize-cc-mode t) (set-syntax-table c-mode-syntax-table) - (setq major-mode 'c-mode ; FIXME: Use define-derived-mode. - mode-name "C" - local-abbrev-table c-mode-abbrev-table + (setq local-abbrev-table c-mode-abbrev-table abbrev-mode t) (use-local-map c-mode-map) (c-init-language-vars-for 'c-mode) @@ -1236,7 +1232,7 @@ (cons "C++" (c-lang-const c-mode-menu c++))) ;;;###autoload -(defun c++-mode () +(define-derived-mode c++-mode prog-mode "C++" "Major mode for editing C++ code. To submit a problem report, enter `\\[c-submit-bug-report]' from a c++-mode buffer. This automatically sets up a mail buffer with @@ -1251,13 +1247,9 @@ Key bindings: \\{c++-mode-map}" - (interactive) - (kill-all-local-variables) (c-initialize-cc-mode t) (set-syntax-table c++-mode-syntax-table) - (setq major-mode 'c++-mode ; FIXME: Use define-derived-mode. - mode-name "C++" - local-abbrev-table c++-mode-abbrev-table + (setq local-abbrev-table c++-mode-abbrev-table abbrev-mode t) (use-local-map c++-mode-map) (c-init-language-vars-for 'c++-mode) @@ -1297,7 +1289,7 @@ ;;;###autoload (add-to-list 'auto-mode-alist '("\\.m\\'" . objc-mode)) ;;;###autoload -(defun objc-mode () +(define-derived-mode objc-mode prog-mode "ObjC" "Major mode for editing Objective C code. To submit a problem report, enter `\\[c-submit-bug-report]' from an objc-mode buffer. This automatically sets up a mail buffer with @@ -1312,13 +1304,9 @@ Key bindings: \\{objc-mode-map}" - (interactive) - (kill-all-local-variables) (c-initialize-cc-mode t) (set-syntax-table objc-mode-syntax-table) - (setq major-mode 'objc-mode ; FIXME: Use define-derived-mode. - mode-name "ObjC" - local-abbrev-table objc-mode-abbrev-table + (setq local-abbrev-table objc-mode-abbrev-table abbrev-mode t) (use-local-map objc-mode-map) (c-init-language-vars-for 'objc-mode) @@ -1367,7 +1355,7 @@ ;;;###autoload (add-to-list 'auto-mode-alist '("\\.java\\'" . java-mode)) ;;;###autoload -(defun java-mode () +(define-derived-mode java-mode prog-mode "Java" "Major mode for editing Java code. To submit a problem report, enter `\\[c-submit-bug-report]' from a java-mode buffer. This automatically sets up a mail buffer with @@ -1382,13 +1370,9 @@ Key bindings: \\{java-mode-map}" - (interactive) - (kill-all-local-variables) (c-initialize-cc-mode t) (set-syntax-table java-mode-syntax-table) - (setq major-mode 'java-mode ; FIXME: Use define-derived-mode. - mode-name "Java" - local-abbrev-table java-mode-abbrev-table + (setq local-abbrev-table java-mode-abbrev-table abbrev-mode t) (use-local-map java-mode-map) (c-init-language-vars-for 'java-mode) @@ -1426,7 +1410,7 @@ ;;;###autoload (add-to-list 'auto-mode-alist '("\\.idl\\'" . idl-mode)) ;;;###autoload -(defun idl-mode () +(define-derived-mode idl-mode prog-mode "IDL" "Major mode for editing CORBA's IDL, PSDL and CIDL code. To submit a problem report, enter `\\[c-submit-bug-report]' from an idl-mode buffer. This automatically sets up a mail buffer with @@ -1441,13 +1425,9 @@ Key bindings: \\{idl-mode-map}" - (interactive) - (kill-all-local-variables) (c-initialize-cc-mode t) (set-syntax-table idl-mode-syntax-table) - (setq major-mode 'idl-mode ; FIXME: Use define-derived-mode. - mode-name "IDL" - local-abbrev-table idl-mode-abbrev-table) + (setq local-abbrev-table idl-mode-abbrev-table) (use-local-map idl-mode-map) (c-init-language-vars-for 'idl-mode) (c-common-init 'idl-mode) @@ -1487,7 +1467,7 @@ ;;;###autoload (add-to-list 'interpreter-mode-alist '("pike" . pike-mode)) ;;;###autoload -(defun pike-mode () +(define-derived-mode pike-mode prog-mode "Pike" "Major mode for editing Pike code. To submit a problem report, enter `\\[c-submit-bug-report]' from a pike-mode buffer. This automatically sets up a mail buffer with @@ -1502,13 +1482,9 @@ Key bindings: \\{pike-mode-map}" - (interactive) - (kill-all-local-variables) (c-initialize-cc-mode t) (set-syntax-table pike-mode-syntax-table) - (setq major-mode 'pike-mode ; FIXME: Use define-derived-mode. - mode-name "Pike" - local-abbrev-table pike-mode-abbrev-table + (setq local-abbrev-table pike-mode-abbrev-table abbrev-mode t) (use-local-map pike-mode-map) (c-init-language-vars-for 'pike-mode) @@ -1561,7 +1537,8 @@ (defvar awk-mode-syntax-table) (declare-function c-awk-unstick-NL-prop "cc-awk" ()) -(defun awk-mode () +;;;###autoload +(define-derived-mode awk-mode prog-mode "AWK" "Major mode for editing AWK code. To submit a problem report, enter `\\[c-submit-bug-report]' from an awk-mode buffer. This automatically sets up a mail buffer with version @@ -1575,14 +1552,10 @@ Key bindings: \\{awk-mode-map}" - (interactive) (require 'cc-awk) ; Added 2003/6/10. - (kill-all-local-variables) (c-initialize-cc-mode t) (set-syntax-table awk-mode-syntax-table) - (setq major-mode 'awk-mode ; FIXME: Use define-derived-mode. - mode-name "AWK" - local-abbrev-table awk-mode-abbrev-table + (setq local-abbrev-table awk-mode-abbrev-table abbrev-mode t) (use-local-map awk-mode-map) (c-init-language-vars-for 'awk-mode) ------------------------------------------------------------ revno: 104400 author: William Xu committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-05-28 12:56:53 -0400 message: * src/nsterm.m (ns_term_shutdown): Synchronize user defaults before exiting (Bug#8239). diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-05-28 12:54:28 +0000 +++ src/ChangeLog 2011-05-28 16:56:53 +0000 @@ -1,3 +1,8 @@ +2011-05-28 William Xu + + * nsterm.m (ns_term_shutdown): Synchronize user defaults before + exiting (Bug#8239). + 2011-05-28 Jim Meyering Avoid a sign-extension bug in crypto_hash_function. === modified file 'src/nsterm.m' --- src/nsterm.m 2011-05-14 09:03:53 +0000 +++ src/nsterm.m 2011-05-28 16:56:53 +0000 @@ -4058,6 +4058,8 @@ void ns_term_shutdown (int sig) { + [[NSUserDefaults standardUserDefaults] synchronize]; + /* code not reached in emacs.c after this is called by shut_down_emacs: */ if (STRINGP (Vauto_save_list_file_name)) unlink (SDATA (Vauto_save_list_file_name)); ------------------------------------------------------------ revno: 104399 committer: Eli Zaretskii branch nick: trunk timestamp: Sat 2011-05-28 15:54:28 +0300 message: src/ChangeLog: Fix last entry. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-05-28 12:19:08 +0000 +++ src/ChangeLog 2011-05-28 12:54:28 +0000 @@ -1,13 +1,13 @@ 2011-05-28 Jim Meyering - avoid a sign-extension bug in crypto_hash_function + Avoid a sign-extension bug in crypto_hash_function. * fns.c (to_uchar): Define. (crypto_hash_function): Use it to convert some newly-signed variables to unsigned, to avoid sign-extension bugs. For example, without this change, (md5 "truc") would evaluate to 45723a2aff78ff4fff7fff1114760e62 rather than the expected 45723a2af3788c4ff17f8d1114760e62. Reported by Antoine Levitt in - http://thread.gmane.org/gmane.emacs.devel/139824 + https://lists.gnu.org/archive/html/emacs-devel/2011-05/msg00883.html. 2011-05-27 Paul Eggert ------------------------------------------------------------ revno: 104398 committer: Jim Meyering branch nick: trunk timestamp: Sat 2011-05-28 14:19:08 +0200 message: avoid a sign-extension bug in crypto_hash_function * fns.c (to_uchar): Define. (crypto_hash_function): Use it to convert some newly-signed variables to unsigned, to avoid sign-extension bugs. For example, without this change, (md5 "truc") would evaluate to 45723a2aff78ff4fff7fff1114760e62 rather than the expected 45723a2af3788c4ff17f8d1114760e62. Reported by Antoine Levitt in http://thread.gmane.org/gmane.emacs.devel/139824 diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-05-27 19:58:54 +0000 +++ src/ChangeLog 2011-05-28 12:19:08 +0000 @@ -1,3 +1,14 @@ +2011-05-28 Jim Meyering + + avoid a sign-extension bug in crypto_hash_function + * fns.c (to_uchar): Define. + (crypto_hash_function): Use it to convert some newly-signed + variables to unsigned, to avoid sign-extension bugs. For example, + without this change, (md5 "truc") would evaluate to + 45723a2aff78ff4fff7fff1114760e62 rather than the expected + 45723a2af3788c4ff17f8d1114760e62. Reported by Antoine Levitt in + http://thread.gmane.org/gmane.emacs.devel/139824 + 2011-05-27 Paul Eggert Integer overflow fixes. === modified file 'src/fns.c' --- src/fns.c 2011-05-27 19:37:32 +0000 +++ src/fns.c 2011-05-28 12:19:08 +0000 @@ -4520,6 +4520,11 @@ #include "md5.h" #include "sha1.h" +/* Convert a possibly-signed character to an unsigned character. This is + a bit safer than casting to unsigned char, since it catches some type + errors that the cast doesn't. */ +static inline unsigned char to_uchar (char ch) { return ch; } + /* TYPE: 0 for md5, 1 for sha1. */ static Lisp_Object @@ -4717,7 +4722,7 @@ { char value[33]; for (i = 0; i < 16; i++) - sprintf (&value[2 * i], "%02x", digest[i]); + sprintf (&value[2 * i], "%02x", to_uchar (digest[i])); res = make_string (value, 32); } else @@ -4735,7 +4740,7 @@ { char value[41]; for (i = 0; i < 20; i++) - sprintf (&value[2 * i], "%02x", digest[i]); + sprintf (&value[2 * i], "%02x", to_uchar (digest[i])); res = make_string (value, 40); } else ------------------------------------------------------------ revno: 104397 [merge] committer: Eli Zaretskii branch nick: trunk timestamp: Sat 2011-05-28 13:02:50 +0300 message: Adapt MSDOS build to introduction of sha1 and other latest changes. msdos/sedlibmk.inp (gl_LIBOBJS): Add sha1.o. msdos/sed1v2.inp: Edit "make-docfile -d FOO" commands to chdir back to src/. Make editing of RUN_TEMACS commands less sensitive to leading whitespace. diff: === modified file 'msdos/ChangeLog' --- msdos/ChangeLog 2011-05-20 09:47:59 +0000 +++ msdos/ChangeLog 2011-05-28 10:00:09 +0000 @@ -1,3 +1,11 @@ +2011-05-28 Eli Zaretskii + + * sed1v2.inp: Edit "make-docfile -d FOO" commands to chdir back to + src/. Make editing of RUN_TEMACS commands less sensitive to + leading whitespace. + + * sedlibmk.inp (gl_LIBOBJS): Add sha1.o. + 2011-05-20 Eli Zaretskii * sed1v2.inp (make-docfile commands): Recognize only if the line === modified file 'msdos/sed1v2.inp' --- msdos/sed1v2.inp 2011-05-20 09:47:59 +0000 +++ msdos/sed1v2.inp 2011-05-28 10:00:09 +0000 @@ -130,13 +130,13 @@ /^ [ ]*\$(libsrc)\/make-docfile.*>.*\/DOC/s!make-docfile!make-docfile -o $(etc)/DOC! /^ [ ]*\$(libsrc)\/make-docfile.*>.*gl-tmp/s!make-docfile!make-docfile -o gl-tmp! /^.\$(libsrc)\/make-doc/s!>.*$!! -/^ [ ]*\$(libsrc)\/make-docfile /s!`[^`]*`!$(lisp)! +/^ [ ]*\$(libsrc)\/make-docfile /s!`[^`]*`!$(lisp); cd ../src! /^[ ]*$/d /^ if test -f/,/^ fi$/c\ command.com /c if exist .gdbinit rm -f _gdbinit /^ if test "\$(CANNOT_DUMP)" =/,/^ else /d /^ fi/d -/^ LC_ALL=C \$(RUN_TEMACS)/i\ +/^ *LC_ALL=C \$(RUN_TEMACS)/i\ stubedit temacs.exe minstack=1024k /^ *LC_ALL=C.*\$(RUN_TEMACS)/s/LC_ALL=C/set &;/ /-batch -l loadup/a\ === modified file 'msdos/sedlibmk.inp' --- msdos/sedlibmk.inp 2011-05-20 09:47:59 +0000 +++ msdos/sedlibmk.inp 2011-05-28 10:00:09 +0000 @@ -521,7 +521,7 @@ /^WINT_T_SUFFIX *=/s/@WINT_T_SUFFIX@// /am__append_1 *=.*gettext\.h/s/@[^@\n]*@/\#/ /am__append_2 *=.*verify\.h/s/@[^@\n]*@// -/^gl_LIBOBJS *=/s/@[^@\n]*@/getopt.o getopt1.o strftime.o time_r.o getloadavg.o md5.o filemode.o/ +/^gl_LIBOBJS *=/s/@[^@\n]*@/getopt.o getopt1.o strftime.o time_r.o getloadavg.o md5.o filemode.o sha1.o/ /^BUILT_SOURCES *=/s/ *inttypes\.h// /^am_libgnu_a_OBJECTS *=/s/careadlinkat\.\$(OBJEXT)// /^am_libgnu_a_OBJECTS *=/s/allocator\.\$(OBJEXT)// ------------------------------------------------------------ revno: 104396 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2011-05-27 23:10:32 -0300 message: * lisp/minibuffer.el (completion--capf-wrapper): Check applicability before retuning non-nil for non-exclusive completion data. * lisp/progmodes/etags.el (tags-completion-at-point-function): * lisp/info-look.el (info-lookup-completions-at-point): Mark as non-exclusive. (info-complete): Adjust accordingly. * lisp/erc/erc-pcomplete.el (erc-pcompletions-at-point): Mark the completion data as non-exclusive if it's using the default-completion-function. (pcomplete-erc-parse-arguments): Rename pcomplete-parse-erc-arguments. (pcomplete-erc-setup): Use new name. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-28 01:33:10 +0000 +++ lisp/ChangeLog 2011-05-28 02:10:32 +0000 @@ -1,5 +1,12 @@ 2011-05-28 Stefan Monnier + * minibuffer.el (completion--capf-wrapper): Check applicability before + retuning non-nil for non-exclusive completion data. + * progmodes/etags.el (tags-completion-at-point-function): + * info-look.el (info-lookup-completions-at-point): Mark as + non-exclusive. + (info-complete): Adjust accordingly. + * info-look.el: Convert to lexical-binding and completion-at-point. (info-lookup-completions-at-point): New function. (info-complete): Use it and completion-in-region. === modified file 'lisp/erc/ChangeLog' --- lisp/erc/ChangeLog 2011-05-03 15:51:14 +0000 +++ lisp/erc/ChangeLog 2011-05-28 02:10:32 +0000 @@ -1,3 +1,10 @@ +2011-05-28 Stefan Monnier + + * erc-pcomplete.el (erc-pcompletions-at-point): Mark the completion + data as non-exclusive if it's using the default-completion-function. + (pcomplete-erc-parse-arguments): Rename pcomplete-parse-erc-arguments. + (pcomplete-erc-setup): Use new name. + 2011-05-03 Debarshi Ray (tiny change) * erc-backend.el (671): New response handler. === modified file 'lisp/erc/erc-pcomplete.el' --- lisp/erc/erc-pcomplete.el 2011-04-29 15:23:59 +0000 +++ lisp/erc/erc-pcomplete.el 2011-05-28 02:10:32 +0000 @@ -73,7 +73,10 @@ "ERC completion data from pcomplete. for use on `completion-at-point-function'." (when (> (point) (erc-beg-of-input-line)) - (pcomplete-completions-at-point))) + (or (let ((pcomplete-default-completion-function #'ignore)) + (pcomplete-completions-at-point)) + (let ((c (pcomplete-completions-at-point))) + (if c (nconc c '(:exclusive no))))))) (defun erc-pcomplete () "Complete the nick before point." @@ -94,7 +97,7 @@ (set (make-local-variable 'pcomplete-use-paring) nil) (set (make-local-variable 'pcomplete-parse-arguments-function) - 'pcomplete-parse-erc-arguments) + 'pcomplete-erc-parse-arguments) (set (make-local-variable 'pcomplete-command-completion-function) 'pcomplete/erc-mode/complete-command) (set (make-local-variable 'pcomplete-command-name-function) @@ -254,7 +257,7 @@ (upcase (substring (pcomplete-arg 'first) 1)) "SAY")) -(defun pcomplete-parse-erc-arguments () +(defun pcomplete-erc-parse-arguments () "Returns a list of parsed whitespace-separated arguments. These are the words from the beginning of the line after the prompt up to where point is right now." === modified file 'lisp/info-look.el' --- lisp/info-look.el 2011-05-28 01:33:10 +0000 +++ lisp/info-look.el 2011-05-28 02:10:32 +0000 @@ -667,7 +667,8 @@ (end-of-line) (while (and (search-backward try nil t) (< start (point)))) - (list (match-beginning 0) (match-end 0) completions)))))))) + (list (match-beginning 0) (match-end 0) completions + :exclusive 'no)))))))) (defun info-complete (topic mode) "Try to complete a help item." @@ -675,7 +676,7 @@ (let ((data (info-lookup-completions-at-point topic mode))) (if (null data) (error "No %s completion available for `%s' at point" topic mode) - (apply #'completion-in-region data)))) + (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data))))) ;;; Initialize some common modes. === modified file 'lisp/minibuffer.el' --- lisp/minibuffer.el 2011-05-24 02:45:50 +0000 +++ lisp/minibuffer.el 2011-05-28 02:10:32 +0000 @@ -1433,12 +1433,19 @@ PROPS is a property list for additional information. Currently supported properties are all the properties that can appear in `completion-extra-properties' plus: - `:predicate' a predicate that completion candidates need to satisfy.") + `:predicate' a predicate that completion candidates need to satisfy. + `:exclusive' If `no', means that if the completion data does not match the + text at point failure, then instead of reporting a completion failure, + the completion should try the next completion function.") (defvar completion--capf-misbehave-funs nil - "List of functions found on `completion-at-point-functions' that misbehave.") + "List of functions found on `completion-at-point-functions' that misbehave. +These are functions that neither return completion data nor a completion +function but instead perform completion right away.") (defvar completion--capf-safe-funs nil - "List of well-behaved functions found on `completion-at-point-functions'.") + "List of well-behaved functions found on `completion-at-point-functions'. +These are functions which return proper completion data rather than +a completion function or god knows what else.") (defun completion--capf-wrapper (fun which) ;; FIXME: The safe/misbehave handling assumes that a given function will @@ -1451,9 +1458,23 @@ (optimist (not (member fun completion--capf-misbehave-funs)))) (let ((res (funcall fun))) (cond - ((consp res) + ((and (consp res) (not (functionp res))) (unless (member fun completion--capf-safe-funs) - (push fun completion--capf-safe-funs))) + (push fun completion--capf-safe-funs)) + (and (eq 'no (plist-get (nthcdr 3 res) :exclusive)) + ;; FIXME: Here we'd need to decide whether there are + ;; valid completions against the current text. But this depends + ;; on the actual completion UI (e.g. with the default completion + ;; it depends on completion-style) ;-( + ;; We approximate this result by checking whether prefix + ;; completion might work, which means that non-prefix completion + ;; will not work (or not right) for completion functions that + ;; are non-exclusive. + (null (try-completion (buffer-substring-no-properties + (car res) (point)) + (nth 2 res) + (plist-get (nthcdr 3 res) :predicate))) + (setq res nil))) ((not (or (listp res) (functionp res))) (unless (member fun completion--capf-misbehave-funs) (message === modified file 'lisp/progmodes/etags.el' --- lisp/progmodes/etags.el 2011-04-24 18:47:17 +0000 +++ lisp/progmodes/etags.el 2011-05-28 02:10:32 +0000 @@ -812,7 +812,7 @@ (search-backward pattern) ;FIXME: will fail if we're inside pattern. (setq beg (point)) (forward-char (length pattern)) - (list beg (point) (tags-lazy-completion-table))))))) + (list beg (point) (tags-lazy-completion-table) :exclusive 'no)))))) (defun find-tag-tag (string) "Read a tag name, with defaulting and completion." ------------------------------------------------------------ revno: 104395 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2011-05-27 22:33:10 -0300 message: * lisp/info-look.el: Convert to lexical-binding and completion-at-point. (info-lookup-completions-at-point): New function. (info-complete): Use it and completion-in-region. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-28 01:26:53 +0000 +++ lisp/ChangeLog 2011-05-28 01:33:10 +0000 @@ -1,3 +1,9 @@ +2011-05-28 Stefan Monnier + + * info-look.el: Convert to lexical-binding and completion-at-point. + (info-lookup-completions-at-point): New function. + (info-complete): Use it and completion-in-region. + 2011-05-28 Drew Adams * isearch.el: Let M-e start with point at the first mismatched char. === modified file 'lisp/info-look.el' --- lisp/info-look.el 2011-05-16 17:41:03 +0000 +++ lisp/info-look.el 2011-05-28 01:33:10 +0000 @@ -1,4 +1,4 @@ -;;; info-look.el --- major-mode-sensitive Info index lookup facility +;;; info-look.el --- major-mode-sensitive Info index lookup facility -*- lexical-binding: t -*- ;; An older version of this was known as libc.el. ;; Copyright (C) 1995-1999, 2001-2011 Free Software Foundation, Inc. @@ -357,7 +357,7 @@ (setq node (nth 0 (car doc-spec)) prefix (nth 2 (car doc-spec)) suffix (nth 3 (car doc-spec))) - (when (condition-case error-data + (when (condition-case nil (progn ;; Don't need Index menu fontifications here, and ;; they slow down the lookup. @@ -473,7 +473,7 @@ (t (nth 1 (car doc-spec))))) (with-current-buffer buffer (message "Processing Info node `%s'..." node) - (when (condition-case error-data + (when (condition-case nil (progn (Info-goto-node node) (setq doc-found t)) @@ -641,44 +641,41 @@ info-lookup-mode (info-lookup-change-mode 'file))))) +(defun info-lookup-completions-at-point (topic mode) + "Try to complete a help item." + (or mode (setq mode (info-lookup-select-mode))) + (when (info-lookup->mode-value topic mode) + (let ((modes (info-lookup-quick-all-modes topic mode)) + (start (point)) + try) + (while (and (not try) modes) + (setq mode (car modes) + modes (cdr modes) + try (info-lookup-guess-default* topic mode)) + (goto-char start)) + (when try + (let ((completions (info-lookup->completions topic mode))) + (when completions + (when (info-lookup->ignore-case topic mode) + (setq completions + (lambda (string pred action) + (let ((completion-ignore-case t)) + (complete-with-action + action completions string pred))))) + (save-excursion + ;; Find the original symbol and zap it. + (end-of-line) + (while (and (search-backward try nil t) + (< start (point)))) + (list (match-beginning 0) (match-end 0) completions)))))))) + (defun info-complete (topic mode) "Try to complete a help item." (barf-if-buffer-read-only) - (or mode (setq mode (info-lookup-select-mode))) - (or (info-lookup->mode-value topic mode) - (error "No %s completion available for `%s'" topic mode)) - (let ((modes (info-lookup-quick-all-modes topic mode)) - (start (point)) - try) - (while (and (not try) modes) - (setq mode (car modes) - modes (cdr modes) - try (info-lookup-guess-default* topic mode)) - (goto-char start)) - (and (not try) - (error "Found no %S to complete" topic)) - (let ((completions (info-lookup->completions topic mode)) - (completion-ignore-case (info-lookup->ignore-case topic mode)) - completion) - (setq completion (try-completion try completions)) - (cond ((not completion) - (ding) - (message "No match")) - ((stringp completion) - (or (assoc completion completions) - (setq completion (completing-read - (format "Complete %S: " topic) - completions nil t completion - info-lookup-history))) - ;; Find the original symbol and zap it. - (end-of-line) - (while (and (search-backward try nil t) - (< start (point)))) - (replace-match "") - (insert completion)) - (t - (message "%s is complete" - (capitalize (prin1-to-string topic)))))))) + (let ((data (info-lookup-completions-at-point topic mode))) + (if (null data) + (error "No %s completion available for `%s' at point" topic mode) + (apply #'completion-in-region data)))) ;;; Initialize some common modes. ------------------------------------------------------------ revno: 104394 author: Drew Adams committer: Stefan Monnier branch nick: trunk timestamp: Fri 2011-05-27 22:26:53 -0300 message: * lisp/isearch.el: Let M-e start with point at the first mismatched char. (isearch-fail-pos): New function. (isearch-edit-string): Use it. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-28 01:14:38 +0000 +++ lisp/ChangeLog 2011-05-28 01:26:53 +0000 @@ -1,3 +1,9 @@ +2011-05-28 Drew Adams + + * isearch.el: Let M-e start with point at the first mismatched char. + (isearch-fail-pos): New function. + (isearch-edit-string): Use it. + 2011-05-28 Dmitry Kurochkin (tiny change) * isearch.el (isearch-range-invisible): Use invisible-p (bug#8721). === modified file 'lisp/isearch.el' --- lisp/isearch.el 2011-05-28 01:14:38 +0000 +++ lisp/isearch.el 2011-05-28 01:26:53 +0000 @@ -1062,6 +1062,22 @@ (defvar minibuffer-history-symbol) ;; from external package gmhist.el +(defun isearch-fail-pos () + "Position of first mismatch in search string, or its length if none." + (let ((cmds isearch-cmds)) + (if (and isearch-success (not isearch-error)) + (length isearch-message) + (while (or (not (isearch-success-state (car cmds))) + (isearch-error-state (car cmds))) + (pop cmds)) + (let ((succ-msg (and cmds (isearch-message-state (car cmds))))) + (if (and (stringp succ-msg) + (< (length succ-msg) (length isearch-message)) + (equal succ-msg + (substring isearch-message 0 (length succ-msg)))) + (length succ-msg) + 0))))) + (defun isearch-edit-string () "Edit the search string in the minibuffer. The following additional command keys are active while editing. @@ -1141,7 +1157,7 @@ (setq isearch-new-string (read-from-minibuffer (isearch-message-prefix nil nil isearch-nonincremental) - isearch-string + (cons isearch-string (1+ (isearch-fail-pos))) minibuffer-local-isearch-map nil (if isearch-regexp (cons 'regexp-search-ring ------------------------------------------------------------ revno: 104393 fixes bug(s): http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8721 author: Dmitry Kurochkin committer: Stefan Monnier branch nick: trunk timestamp: Fri 2011-05-27 22:14:38 -0300 message: * lisp/isearch.el (isearch-range-invisible): Use invisible-p. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-27 23:03:26 +0000 +++ lisp/ChangeLog 2011-05-28 01:14:38 +0000 @@ -1,3 +1,7 @@ +2011-05-28 Dmitry Kurochkin (tiny change) + + * isearch.el (isearch-range-invisible): Use invisible-p (bug#8721). + 2009-11-23 Toby Cubitt * emacs-lisp/avl-tree.el: New avl-tree-stack datatype. Add new === modified file 'lisp/isearch.el' --- lisp/isearch.el 2011-05-24 18:15:07 +0000 +++ lisp/isearch.el 2011-05-28 01:14:38 +0000 @@ -2435,7 +2435,7 @@ ;; skip all characters with that same `invisible' property value. ;; Do that over and over. (while (and (< (point) end) (invisible-p (point))) - (if (get-text-property (point) 'invisible) + (if (invisible-p (get-text-property (point) 'invisible)) (progn (goto-char (next-single-property-change (point) 'invisible nil end)) ------------------------------------------------------------ revno: 104392 [merge] author: Toby Cubitt committer: Stefan Monnier branch nick: trunk timestamp: Fri 2011-05-27 20:03:26 -0300 message: * lisp/emacs-lisp/avl-tree.el: New avl-tree-stack datatype. Add new traversal functions for avl-trees. Consolidate rebalancing code. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-27 19:33:48 +0000 +++ lisp/ChangeLog 2011-05-27 23:03:26 +0000 @@ -1,4 +1,34 @@ -2011-05-27 David Michael +2009-11-23 Toby Cubitt + + * emacs-lisp/avl-tree.el: New avl-tree-stack datatype. Add new + traversal functions for avl-trees. + (avl-tree--stack): New struct. + (avl-tree-stack-p, avl-tree--stack-repopulate): New funs. + (avl-tree-enter): Add optional `updatefun' arg. + (avl-tree--do-enter): Add optional `updatefun' arg. + Change return value. + (avl-tree-delete): Add optional `test' and `nilflag' args. + (avl-tree--do-delete): Add `test' and `nilflag' args. + Change return value. + (avl-tree-member): Add optional `nilflag' + (avl-tree-member-p): New function. + (avl-tree-mapc, avl-tree-mapf, avl-tree-mapcar): New functions. + (avl-tree-stack, avl-tree-stack-pop, avl-tree-stack-first) + (avl-tree-stack-empty-p): New functions. + +2009-11-23 Toby Cubitt + + * emacs-lisp/avl-tree.el (avl-tree--del-balance): Rename from + avl-tree--del-balance1 and make it work both ways. + (avl-tree--del-balance2): Remove. + (avl-tree--enter-balance): Rename from avl-tree--enter-balance1 and + make it work both ways. + (avl-tree--enter-balance2): Remove. + (avl-tree--switch-dir, avl-tree--dir-to-sign, avl-tree--sign-to-dir): + New macros. + (avl-tree--mapc, avl-tree-map): Add direction argument. + +2011-05-27 David Michael (tiny change) * files.el (interpreter-mode-alist): Add rbash (bug#8745). === modified file 'lisp/emacs-lisp/avl-tree.el' --- lisp/emacs-lisp/avl-tree.el 2011-01-25 04:08:28 +0000 +++ lisp/emacs-lisp/avl-tree.el 2011-05-27 22:58:29 +0000 @@ -3,11 +3,12 @@ ;; Copyright (C) 1995, 2007-2011 Free Software Foundation, Inc. ;; Author: Per Cederqvist -;; Inge Wallin -;; Thomas Bellman +;; Inge Wallin +;; Thomas Bellman +;; Toby Cubitt ;; Maintainer: FSF ;; Created: 10 May 1991 -;; Keywords: extensions, data structures +;; Keywords: extensions, data structures, AVL, tree ;; This file is part of GNU Emacs. @@ -26,14 +27,24 @@ ;;; Commentary: -;; An AVL tree is a nearly-perfect balanced binary tree. A tree consists of -;; two elements, the root node and the compare function. The actual tree -;; has a dummy node as its root with the real root in the left pointer. +;; An AVL tree is a self-balancing binary tree. As such, inserting, +;; deleting, and retrieving data from an AVL tree containing n elements +;; is O(log n). It is somewhat more rigidly balanced than other +;; self-balancing binary trees (such as red-black trees and AA trees), +;; making insertion slighty slower, deletion somewhat slower, and +;; retrieval somewhat faster (the asymptotic scaling is of course the +;; same for all types). Thus it may be a good choice when the tree will +;; be relatively static, i.e. data will be retrieved more often than +;; they are modified. +;; +;; Internally, a tree consists of two elements, the root node and the +;; comparison function. The actual tree has a dummy node as its root +;; with the real root in the left pointer, which allows the root node to +;; be treated on a par with all other nodes. ;; ;; Each node of the tree consists of one data element, one left -;; sub-tree and one right sub-tree. Each node also has a balance -;; count, which is the difference in depth of the left and right -;; sub-trees. +;; sub-tree, one right sub-tree, and a balance count. The latter is the +;; difference in depth of the left and right sub-trees. ;; ;; The functions with names of the form "avl-tree--" are intended for ;; internal use only. @@ -42,43 +53,21 @@ (eval-when-compile (require 'cl)) -;; ================================================================ -;;; Functions and macros handling an AVL tree node. - -(defstruct (avl-tree--node - ;; We force a representation without tag so it matches the - ;; pre-defstruct representation. Also we use the underlying - ;; representation in the implementation of avl-tree--node-branch. - (:type vector) - (:constructor nil) - (:constructor avl-tree--node-create (left right data balance)) - (:copier nil)) - left right data balance) - -(defalias 'avl-tree--node-branch 'aref - ;; This implementation is efficient but breaks the defstruct abstraction. - ;; An alternative could be - ;; (funcall (aref [avl-tree-left avl-tree-right avl-tree-data] branch) node) - "Get value of a branch of a node. - -NODE is the node, and BRANCH is the branch. -0 for left pointer, 1 for right pointer and 2 for the data.\" -\(fn node branch)") -;; The funcall/aref trick doesn't work for the setf method, unless we try -;; and access the underlying setter function, but this wouldn't be -;; portable either. -(defsetf avl-tree--node-branch aset) - - -;; ================================================================ -;;; Internal functions for use in the AVL tree package + + +;; ================================================================ +;;; Internal functions and macros for use in the AVL tree package + + +;; ---------------------------------------------------------------- +;; Functions and macros handling an AVL tree. (defstruct (avl-tree- ;; A tagged list is the pre-defstruct representation. ;; (:type list) :named (:constructor nil) - (:constructor avl-tree-create (cmpfun)) + (:constructor avl-tree--create (cmpfun)) (:predicate avl-tree-p) (:copier nil)) (dummyroot (avl-tree--node-create nil nil nil 0)) @@ -86,272 +75,304 @@ (defmacro avl-tree--root (tree) ;; Return the root node for an avl-tree. INTERNAL USE ONLY. - `(avl-tree--node-left (avl-tree--dummyroot tree))) + `(avl-tree--node-left (avl-tree--dummyroot ,tree))) + (defsetf avl-tree--root (tree) (node) `(setf (avl-tree--node-left (avl-tree--dummyroot ,tree)) ,node)) + + +;; ---------------------------------------------------------------- +;; Functions and macros handling an AVL tree node. + +(defstruct (avl-tree--node + ;; We force a representation without tag so it matches the + ;; pre-defstruct representation. Also we use the underlying + ;; representation in the implementation of + ;; avl-tree--node-branch. + (:type vector) + (:constructor nil) + (:constructor avl-tree--node-create (left right data balance)) + (:copier nil)) + left right data balance) + + +(defalias 'avl-tree--node-branch 'aref + ;; This implementation is efficient but breaks the defstruct + ;; abstraction. An alternative could be (funcall (aref [avl-tree-left + ;; avl-tree-right avl-tree-data] branch) node) + "Get value of a branch of a node. +NODE is the node, and BRANCH is the branch. +0 for left pointer, 1 for right pointer and 2 for the data.") + + +;; The funcall/aref trick wouldn't work for the setf method, unless we +;; tried to access the underlying setter function, but this wouldn't be +;; portable either. +(defsetf avl-tree--node-branch aset) + + + +;; ---------------------------------------------------------------- +;; Convenience macros + +(defmacro avl-tree--switch-dir (dir) + "Return opposite direction to DIR (0 = left, 1 = right)." + `(- 1 ,dir)) + +(defmacro avl-tree--dir-to-sign (dir) + "Convert direction (0,1) to sign factor (-1,+1)." + `(1- (* 2 ,dir))) + +(defmacro avl-tree--sign-to-dir (dir) + "Convert sign factor (-x,+x) to direction (0,1)." + `(if (< ,dir 0) 0 1)) + + ;; ---------------------------------------------------------------- ;; Deleting data -(defun avl-tree--del-balance1 (node branch) - ;; Rebalance a tree and return t if the height of the tree has shrunk. - (let ((br (avl-tree--node-branch node branch)) - p1 b1 p2 b2 result) - (cond - ((< (avl-tree--node-balance br) 0) - (setf (avl-tree--node-balance br) 0) - t) - - ((= (avl-tree--node-balance br) 0) - (setf (avl-tree--node-balance br) +1) - nil) - - (t - ;; Rebalance. - (setq p1 (avl-tree--node-right br) - b1 (avl-tree--node-balance p1)) - (if (>= b1 0) - ;; Single RR rotation. - (progn - (setf (avl-tree--node-right br) (avl-tree--node-left p1)) - (setf (avl-tree--node-left p1) br) - (if (= 0 b1) - (progn - (setf (avl-tree--node-balance br) +1) - (setf (avl-tree--node-balance p1) -1) - (setq result nil)) - (setf (avl-tree--node-balance br) 0) - (setf (avl-tree--node-balance p1) 0) - (setq result t)) - (setf (avl-tree--node-branch node branch) p1) - result) - - ;; Double RL rotation. - (setq p2 (avl-tree--node-left p1) - b2 (avl-tree--node-balance p2)) - (setf (avl-tree--node-left p1) (avl-tree--node-right p2)) - (setf (avl-tree--node-right p2) p1) - (setf (avl-tree--node-right br) (avl-tree--node-left p2)) - (setf (avl-tree--node-left p2) br) - (setf (avl-tree--node-balance br) (if (> b2 0) -1 0)) - (setf (avl-tree--node-balance p1) (if (< b2 0) +1 0)) - (setf (avl-tree--node-branch node branch) p2) - (setf (avl-tree--node-balance p2) 0) - t))))) - -(defun avl-tree--del-balance2 (node branch) - (let ((br (avl-tree--node-branch node branch)) - p1 b1 p2 b2 result) - (cond - ((> (avl-tree--node-balance br) 0) - (setf (avl-tree--node-balance br) 0) - t) - - ((= (avl-tree--node-balance br) 0) - (setf (avl-tree--node-balance br) -1) - nil) - - (t - ;; Rebalance. - (setq p1 (avl-tree--node-left br) - b1 (avl-tree--node-balance p1)) - (if (<= b1 0) - ;; Single LL rotation. - (progn - (setf (avl-tree--node-left br) (avl-tree--node-right p1)) - (setf (avl-tree--node-right p1) br) - (if (= 0 b1) - (progn - (setf (avl-tree--node-balance br) -1) - (setf (avl-tree--node-balance p1) +1) - (setq result nil)) - (setf (avl-tree--node-balance br) 0) - (setf (avl-tree--node-balance p1) 0) - (setq result t)) - (setf (avl-tree--node-branch node branch) p1) - result) - - ;; Double LR rotation. - (setq p2 (avl-tree--node-right p1) - b2 (avl-tree--node-balance p2)) - (setf (avl-tree--node-right p1) (avl-tree--node-left p2)) - (setf (avl-tree--node-left p2) p1) - (setf (avl-tree--node-left br) (avl-tree--node-right p2)) - (setf (avl-tree--node-right p2) br) - (setf (avl-tree--node-balance br) (if (< b2 0) +1 0)) - (setf (avl-tree--node-balance p1) (if (> b2 0) -1 0)) - (setf (avl-tree--node-branch node branch) p2) - (setf (avl-tree--node-balance p2) 0) +(defun avl-tree--del-balance (node branch dir) + "Rebalance a tree after deleting a node. +The deletion was done from the left (DIR=0) or right (DIR=1) sub-tree of the +left (BRANCH=0) or right (BRANCH=1) child of NODE. +Return t if the height of the tree has shrunk." + ;; (or is it vice-versa for BRANCH?) + (let ((br (avl-tree--node-branch node branch)) + ;; opposite direction: 0,1 -> 1,0 + (opp (avl-tree--switch-dir dir)) + ;; direction 0,1 -> sign factor -1,+1 + (sgn (avl-tree--dir-to-sign dir)) + p1 b1 p2 b2) + (cond + ((> (* sgn (avl-tree--node-balance br)) 0) + (setf (avl-tree--node-balance br) 0) + t) + + ((= (avl-tree--node-balance br) 0) + (setf (avl-tree--node-balance br) (- sgn)) + nil) + + (t + ;; Rebalance. + (setq p1 (avl-tree--node-branch br opp) + b1 (avl-tree--node-balance p1)) + (if (<= (* sgn b1) 0) + ;; Single rotation. + (progn + (setf (avl-tree--node-branch br opp) + (avl-tree--node-branch p1 dir) + (avl-tree--node-branch p1 dir) br + (avl-tree--node-branch node branch) p1) + (if (= 0 b1) + (progn + (setf (avl-tree--node-balance br) (- sgn) + (avl-tree--node-balance p1) sgn) + nil) ; height hasn't changed + (setf (avl-tree--node-balance br) 0) + (setf (avl-tree--node-balance p1) 0) + t)) ; height has changed + + ;; Double rotation. + (setf p2 (avl-tree--node-branch p1 dir) + b2 (avl-tree--node-balance p2) + (avl-tree--node-branch p1 dir) + (avl-tree--node-branch p2 opp) + (avl-tree--node-branch p2 opp) p1 + (avl-tree--node-branch br opp) + (avl-tree--node-branch p2 dir) + (avl-tree--node-branch p2 dir) br + (avl-tree--node-balance br) + (if (< (* sgn b2) 0) sgn 0) + (avl-tree--node-balance p1) + (if (> (* sgn b2) 0) (- sgn) 0) + (avl-tree--node-branch node branch) p2 + (avl-tree--node-balance p2) 0) t))))) (defun avl-tree--do-del-internal (node branch q) (let ((br (avl-tree--node-branch node branch))) (if (avl-tree--node-right br) - (if (avl-tree--do-del-internal br +1 q) - (avl-tree--del-balance2 node branch)) - (setf (avl-tree--node-data q) (avl-tree--node-data br)) - (setf (avl-tree--node-branch node branch) - (avl-tree--node-left br)) + (if (avl-tree--do-del-internal br 1 q) + (avl-tree--del-balance node branch 1)) + (setf (avl-tree--node-data q) (avl-tree--node-data br) + (avl-tree--node-branch node branch) + (avl-tree--node-left br)) t))) -(defun avl-tree--do-delete (cmpfun root branch data) - ;; Return t if the height of the tree has shrunk. +(defun avl-tree--do-delete (cmpfun root branch data test nilflag) + "Delete DATA from BRANCH of node ROOT. +\(See `avl-tree-delete' for TEST and NILFLAG). + +Return cons cell (SHRUNK . DATA), where SHRUNK is t if the +height of the tree has shrunk and nil otherwise, and DATA is +the releted data." (let ((br (avl-tree--node-branch root branch))) (cond + ;; DATA not in tree. ((null br) - nil) + (cons nil nilflag)) ((funcall cmpfun data (avl-tree--node-data br)) - (if (avl-tree--do-delete cmpfun br 0 data) - (avl-tree--del-balance1 root branch))) + (let ((ret (avl-tree--do-delete cmpfun br 0 data test nilflag))) + (cons (if (car ret) (avl-tree--del-balance root branch 0)) + (cdr ret)))) ((funcall cmpfun (avl-tree--node-data br) data) - (if (avl-tree--do-delete cmpfun br 1 data) - (avl-tree--del-balance2 root branch))) - - (t - ;; Found it. Let's delete it. - (cond - ((null (avl-tree--node-right br)) - (setf (avl-tree--node-branch root branch) (avl-tree--node-left br)) - t) - - ((null (avl-tree--node-left br)) - (setf (avl-tree--node-branch root branch) (avl-tree--node-right br)) - t) - - (t - (if (avl-tree--do-del-internal br 0 br) - (avl-tree--del-balance1 root branch)))))))) + (let ((ret (avl-tree--do-delete cmpfun br 1 data test nilflag))) + (cons (if (car ret) (avl-tree--del-balance root branch 1)) + (cdr ret)))) + + (t ; Found it. + ;; if it fails TEST, do nothing + (if (and test (not (funcall test (avl-tree--node-data br)))) + (cons nil nilflag) + (cond + ((null (avl-tree--node-right br)) + (setf (avl-tree--node-branch root branch) + (avl-tree--node-left br)) + (cons t (avl-tree--node-data br))) + + ((null (avl-tree--node-left br)) + (setf (avl-tree--node-branch root branch) + (avl-tree--node-right br)) + (cons t (avl-tree--node-data br))) + + (t + (if (avl-tree--do-del-internal br 0 br) + (cons (avl-tree--del-balance root branch 0) + (avl-tree--node-data br)) + (cons nil (avl-tree--node-data br)))) + )))))) + + ;; ---------------------------------------------------------------- ;; Entering data -(defun avl-tree--enter-balance1 (node branch) - ;; Rebalance a tree and return t if the height of the tree has grown. +(defun avl-tree--enter-balance (node branch dir) + "Rebalance tree after an insertion +into the left (DIR=0) or right (DIR=1) sub-tree of the +left (BRANCH=0) or right (BRANCH=1) child of NODE. +Return t if the height of the tree has grown." (let ((br (avl-tree--node-branch node branch)) + ;; opposite direction: 0,1 -> 1,0 + (opp (avl-tree--switch-dir dir)) + ;; direction 0,1 -> sign factor -1,+1 + (sgn (avl-tree--dir-to-sign dir)) p1 p2 b2 result) (cond - ((< (avl-tree--node-balance br) 0) + ((< (* sgn (avl-tree--node-balance br)) 0) (setf (avl-tree--node-balance br) 0) nil) ((= (avl-tree--node-balance br) 0) - (setf (avl-tree--node-balance br) +1) + (setf (avl-tree--node-balance br) sgn) t) (t ;; Tree has grown => Rebalance. - (setq p1 (avl-tree--node-right br)) - (if (> (avl-tree--node-balance p1) 0) - ;; Single RR rotation. - (progn - (setf (avl-tree--node-right br) (avl-tree--node-left p1)) - (setf (avl-tree--node-left p1) br) - (setf (avl-tree--node-balance br) 0) - (setf (avl-tree--node-branch node branch) p1)) - - ;; Double RL rotation. - (setq p2 (avl-tree--node-left p1) - b2 (avl-tree--node-balance p2)) - (setf (avl-tree--node-left p1) (avl-tree--node-right p2)) - (setf (avl-tree--node-right p2) p1) - (setf (avl-tree--node-right br) (avl-tree--node-left p2)) - (setf (avl-tree--node-left p2) br) - (setf (avl-tree--node-balance br) (if (> b2 0) -1 0)) - (setf (avl-tree--node-balance p1) (if (< b2 0) +1 0)) - (setf (avl-tree--node-branch node branch) p2)) - (setf (avl-tree--node-balance (avl-tree--node-branch node branch)) 0) - nil)))) - -(defun avl-tree--enter-balance2 (node branch) - ;; Return t if the tree has grown. - (let ((br (avl-tree--node-branch node branch)) - p1 p2 b2) - (cond - ((> (avl-tree--node-balance br) 0) - (setf (avl-tree--node-balance br) 0) - nil) - - ((= (avl-tree--node-balance br) 0) - (setf (avl-tree--node-balance br) -1) - t) - - (t - ;; Balance was -1 => Rebalance. - (setq p1 (avl-tree--node-left br)) - (if (< (avl-tree--node-balance p1) 0) - ;; Single LL rotation. - (progn - (setf (avl-tree--node-left br) (avl-tree--node-right p1)) - (setf (avl-tree--node-right p1) br) - (setf (avl-tree--node-balance br) 0) - (setf (avl-tree--node-branch node branch) p1)) - - ;; Double LR rotation. - (setq p2 (avl-tree--node-right p1) - b2 (avl-tree--node-balance p2)) - (setf (avl-tree--node-right p1) (avl-tree--node-left p2)) - (setf (avl-tree--node-left p2) p1) - (setf (avl-tree--node-left br) (avl-tree--node-right p2)) - (setf (avl-tree--node-right p2) br) - (setf (avl-tree--node-balance br) (if (< b2 0) +1 0)) - (setf (avl-tree--node-balance p1) (if (> b2 0) -1 0)) - (setf (avl-tree--node-branch node branch) p2)) - (setf (avl-tree--node-balance (avl-tree--node-branch node branch)) 0) - nil)))) - -(defun avl-tree--do-enter (cmpfun root branch data) - ;; Return t if height of tree ROOT has grown. INTERNAL USE ONLY. + (setq p1 (avl-tree--node-branch br dir)) + (if (> (* sgn (avl-tree--node-balance p1)) 0) + ;; Single rotation. + (progn + (setf (avl-tree--node-branch br dir) + (avl-tree--node-branch p1 opp)) + (setf (avl-tree--node-branch p1 opp) br) + (setf (avl-tree--node-balance br) 0) + (setf (avl-tree--node-branch node branch) p1)) + + ;; Double rotation. + (setf p2 (avl-tree--node-branch p1 opp) + b2 (avl-tree--node-balance p2) + (avl-tree--node-branch p1 opp) + (avl-tree--node-branch p2 dir) + (avl-tree--node-branch p2 dir) p1 + (avl-tree--node-branch br dir) + (avl-tree--node-branch p2 opp) + (avl-tree--node-branch p2 opp) br + (avl-tree--node-balance br) + (if (> (* sgn b2) 0) (- sgn) 0) + (avl-tree--node-balance p1) + (if (< (* sgn b2) 0) sgn 0) + (avl-tree--node-branch node branch) p2 + (avl-tree--node-balance + (avl-tree--node-branch node branch)) 0)) + nil)))) + +(defun avl-tree--do-enter (cmpfun root branch data &optional updatefun) + "Enter DATA in BRANCH of ROOT node. +\(See `avl-tree-enter' for UPDATEFUN). + +Return cons cell (GREW . DATA), where GREW is t if height +of tree ROOT has grown and nil otherwise, and DATA is the +inserted data." (let ((br (avl-tree--node-branch root branch))) (cond ((null br) ;; Data not in tree, insert it. (setf (avl-tree--node-branch root branch) (avl-tree--node-create nil nil data 0)) - t) + (cons t data)) ((funcall cmpfun data (avl-tree--node-data br)) - (and (avl-tree--do-enter cmpfun br 0 data) - (avl-tree--enter-balance2 root branch))) + (let ((ret (avl-tree--do-enter cmpfun br 0 data updatefun))) + (cons (and (car ret) (avl-tree--enter-balance root branch 0)) + (cdr ret)))) ((funcall cmpfun (avl-tree--node-data br) data) - (and (avl-tree--do-enter cmpfun br 1 data) - (avl-tree--enter-balance1 root branch))) + (let ((ret (avl-tree--do-enter cmpfun br 1 data updatefun))) + (cons (and (car ret) (avl-tree--enter-balance root branch 1)) + (cdr ret)))) + ;; Data already in tree, update it. (t - (setf (avl-tree--node-data br) data) - nil)))) + (let ((newdata + (if updatefun + (funcall updatefun data (avl-tree--node-data br)) + data))) + (if (or (funcall cmpfun newdata data) + (funcall cmpfun data newdata)) + (error "avl-tree-enter:\ + updated data does not match existing data")) + (setf (avl-tree--node-data br) newdata) + (cons nil newdata)) ; return value + )))) ;; ---------------------------------------------------------------- -(defun avl-tree--mapc (map-function root) - ;; Apply MAP-FUNCTION to all nodes in the tree starting with ROOT. - ;; The function is applied in-order. - ;; - ;; Note: MAP-FUNCTION is applied to the node and not to the data itself. - ;; INTERNAL USE ONLY. + +;;; INTERNAL USE ONLY +(defun avl-tree--mapc (map-function root dir) + "Apply MAP-FUNCTION to all nodes in the tree starting with ROOT. +The function is applied in-order, either ascending (DIR=0) or +descending (DIR=1). + +Note: MAP-FUNCTION is applied to the node and not to the data +itself." (let ((node root) (stack nil) - (go-left t)) + (go-dir t)) (push nil stack) (while node - (if (and go-left - (avl-tree--node-left node)) - ;; Do the left subtree first. + (if (and go-dir + (avl-tree--node-branch node dir)) + ;; Do the DIR subtree first. (progn (push node stack) - (setq node (avl-tree--node-left node))) + (setq node (avl-tree--node-branch node dir))) ;; Apply the function... (funcall map-function node) - ;; and do the right subtree. - (setq node (if (setq go-left (avl-tree--node-right node)) - (avl-tree--node-right node) + ;; and do the opposite subtree. + (setq node (if (setq go-dir (avl-tree--node-branch + node (avl-tree--switch-dir dir))) + (avl-tree--node-branch + node (avl-tree--switch-dir dir)) (pop stack))))))) +;;; INTERNAL USE ONLY (defun avl-tree--do-copy (root) - ;; Copy the avl tree with ROOT as root. - ;; Highly recursive. INTERNAL USE ONLY. + "Copy the avl tree with ROOT as root. Highly recursive." (if (null root) nil (avl-tree--node-create @@ -360,10 +381,40 @@ (avl-tree--node-data root) (avl-tree--node-balance root)))) - +(defstruct (avl-tree--stack + (:constructor nil) + (:constructor avl-tree--stack-create + (tree &optional reverse + &aux + (store + (if (avl-tree-empty tree) + nil + (list (avl-tree--root tree)))))) + (:copier nil)) + reverse store) + +(defalias 'avl-tree-stack-p 'avl-tree--stack-p + "Return t if argument is an avl-tree-stack, nil otherwise.") + +(defun avl-tree--stack-repopulate (stack) + ;; Recursively push children of the node at the head of STACK onto the + ;; front of the STACK, until a leaf is reached. + (let ((node (car (avl-tree--stack-store stack))) + (dir (if (avl-tree--stack-reverse stack) 1 0))) + (when node ; check for emtpy stack + (while (setq node (avl-tree--node-branch node dir)) + (push node (avl-tree--stack-store stack)))))) + + ;; ================================================================ ;;; The public functions which operate on AVL trees. +;; define public alias for constructors so that we can set docstring +(defalias 'avl-tree-create 'avl-tree--create + "Create an empty avl tree. +COMPARE-FUNCTION is a function which takes two arguments, A and B, +and returns non-nil if A is less than B, and nil otherwise.") + (defalias 'avl-tree-compare-function 'avl-tree--cmpfun "Return the comparison function for the avl tree TREE. @@ -373,53 +424,142 @@ "Return t if avl tree TREE is emtpy, otherwise return nil." (null (avl-tree--root tree))) -(defun avl-tree-enter (tree data) - "In the avl tree TREE insert DATA. -Return DATA." - (avl-tree--do-enter (avl-tree--cmpfun tree) - (avl-tree--dummyroot tree) - 0 - data) - data) - -(defun avl-tree-delete (tree data) - "From the avl tree TREE, delete DATA. -Return the element in TREE which matched DATA, -nil if no element matched." - (avl-tree--do-delete (avl-tree--cmpfun tree) - (avl-tree--dummyroot tree) - 0 - data)) - -(defun avl-tree-member (tree data) +(defun avl-tree-enter (tree data &optional updatefun) + "Insert DATA into the avl tree TREE. + +If an element that matches DATA (according to the tree's +comparison function, see `avl-tree-create') already exists in +TREE, it will be replaced by DATA by default. + +If UPDATEFUN is supplied and an element matching DATA already +exists in TREE, UPDATEFUN is called with two arguments: DATA, and +the matching element. Its return value replaces the existing +element. This value *must* itself match DATA (and hence the +pre-existing data), or an error will occur. + +Returns the new data." + (cdr (avl-tree--do-enter (avl-tree--cmpfun tree) + (avl-tree--dummyroot tree) + 0 data updatefun))) + +(defun avl-tree-delete (tree data &optional test nilflag) + "Delete the element matching DATA from the avl tree TREE. +Matching uses the comparison function previously specified in +`avl-tree-create' when TREE was created. + +Returns the deleted element, or nil if no matching element was +found. + +Optional argument NILFLAG specifies a value to return instead of +nil if nothing was deleted, so that this case can be +distinguished from the case of a successfully deleted null +element. + +If supplied, TEST specifies a test that a matching element must +pass before it is deleted. If a matching element is found, it is +passed as an argument to TEST, and is deleted only if the return +value is non-nil." + (cdr (avl-tree--do-delete (avl-tree--cmpfun tree) + (avl-tree--dummyroot tree) + 0 data test nilflag))) + + +(defun avl-tree-member (tree data &optional nilflag) "Return the element in the avl tree TREE which matches DATA. -Matching uses the compare function previously specified in +Matching uses the comparison function previously specified in `avl-tree-create' when TREE was created. -If there is no such element in the tree, the value is nil." +If there is no such element in the tree, nil is +returned. Optional argument NILFLAG specifies a value to return +instead of nil in this case. This allows non-existent elements to +be distinguished from a null element. (See also +`avl-tree-member-p', which does this for you.)" (let ((node (avl-tree--root tree)) - (compare-function (avl-tree--cmpfun tree)) - found) - (while (and node - (not found)) - (cond - ((funcall compare-function data (avl-tree--node-data node)) - (setq node (avl-tree--node-left node))) - ((funcall compare-function (avl-tree--node-data node) data) - (setq node (avl-tree--node-right node))) - (t - (setq found t)))) - (if node - (avl-tree--node-data node) - nil))) - -(defun avl-tree-map (__map-function__ tree) - "Apply __MAP-FUNCTION__ to all elements in the avl tree TREE." + (compare-function (avl-tree--cmpfun tree))) + (catch 'found + (while node + (cond + ((funcall compare-function data (avl-tree--node-data node)) + (setq node (avl-tree--node-left node))) + ((funcall compare-function (avl-tree--node-data node) data) + (setq node (avl-tree--node-right node))) + (t (throw 'found (avl-tree--node-data node))))) + nilflag))) + + +(defun avl-tree-member-p (tree data) + "Return t if an element matching DATA exists in the avl tree TREE, +otherwise return nil. Matching uses the comparison function +previously specified in `avl-tree-create' when TREE was created." + (let ((flag '(nil))) + (not (eq (avl-tree-member tree data flag) flag)))) + + +(defun avl-tree-map (__map-function__ tree &optional reverse) + "Modify all elements in the avl tree TREE by applying FUNCTION. + +Each element is replaced by the return value of FUNCTION applied +to that element. + +FUNCTION is applied to the elements in ascending order, or +descending order if REVERSE is non-nil." (avl-tree--mapc (lambda (node) (setf (avl-tree--node-data node) (funcall __map-function__ (avl-tree--node-data node)))) - (avl-tree--root tree))) + (avl-tree--root tree) + (if reverse 1 0))) + + +(defun avl-tree-mapc (__map-function__ tree &optional reverse) + "Apply FUNCTION to all elements in avl tree TREE, +for side-effect only. + +FUNCTION is applied to the elements in ascending order, or +descending order if REVERSE is non-nil." + (avl-tree--mapc + (lambda (node) + (funcall __map-function__ (avl-tree--node-data node))) + (avl-tree--root tree) + (if reverse 1 0))) + + +(defun avl-tree-mapf + (__map-function__ combinator tree &optional reverse) + "Apply FUNCTION to all elements in avl tree TREE, +and combine the results using COMBINATOR. + +The FUNCTION is applied and the results are combined in ascending +order, or descending order if REVERSE is non-nil." + (let (avl-tree-mapf--accumulate) + (avl-tree--mapc + (lambda (node) + (setq avl-tree-mapf--accumulate + (funcall combinator + (funcall __map-function__ + (avl-tree--node-data node)) + avl-tree-mapf--accumulate))) + (avl-tree--root tree) + (if reverse 0 1)) + (nreverse avl-tree-mapf--accumulate))) + + +(defun avl-tree-mapcar (__map-function__ tree &optional reverse) + "Apply FUNCTION to all elements in avl tree TREE, +and make a list of the results. + +The FUNCTION is applied and the list constructed in ascending +order, or descending order if REVERSE is non-nil. + +Note that if you don't care about the order in which FUNCTION is +applied, just that the resulting list is in the correct order, +then + + (avl-tree-mapf function 'cons tree (not reverse)) + +is more efficient." + (nreverse (avl-tree-mapf __map-function__ 'cons tree reverse))) + (defun avl-tree-first (tree) "Return the first element in TREE, or nil if TREE is empty." @@ -445,25 +585,83 @@ (defun avl-tree-flatten (tree) "Return a sorted list containing all elements of TREE." - (nreverse (let ((treelist nil)) (avl-tree--mapc (lambda (node) (push (avl-tree--node-data node) treelist)) - (avl-tree--root tree)) - treelist))) + (avl-tree--root tree) 1) + treelist)) (defun avl-tree-size (tree) "Return the number of elements in TREE." (let ((treesize 0)) (avl-tree--mapc (lambda (data) (setq treesize (1+ treesize))) - (avl-tree--root tree)) + (avl-tree--root tree) 0) treesize)) (defun avl-tree-clear (tree) "Clear the avl tree TREE." (setf (avl-tree--root tree) nil)) + +(defun avl-tree-stack (tree &optional reverse) + "Return an object that behaves like a sorted stack +of all elements of TREE. + +If REVERSE is non-nil, the stack is sorted in reverse order. +\(See also `avl-tree-stack-pop'\). + +Note that any modification to TREE *immediately* invalidates all +avl-tree-stacks created before the modification (in particular, +calling `avl-tree-stack-pop' will give unpredictable results). + +Operations on these objects are significantly more efficient than +constructing a real stack with `avl-tree-flatten' and using +standard stack functions. As such, they can be useful in +implementing efficient algorithms of AVL trees. However, in cases +where mapping functions `avl-tree-mapc', `avl-tree-mapcar' or +`avl-tree-mapf' would be sufficient, it is better to use one of +those instead." + (let ((stack (avl-tree--stack-create tree reverse))) + (avl-tree--stack-repopulate stack) + stack)) + + +(defun avl-tree-stack-pop (avl-tree-stack &optional nilflag) + "Pop the first element from AVL-TREE-STACK. +\(See also `avl-tree-stack'\). + +Returns nil if the stack is empty, or NILFLAG if specified. (The +latter allows an empty stack to be distinguished from a null +element stored in the AVL tree.)" + (let (node next) + (if (not (setq node (pop (avl-tree--stack-store avl-tree-stack)))) + nilflag + (when (setq next + (avl-tree--node-branch + node + (if (avl-tree--stack-reverse avl-tree-stack) 0 1))) + (push next (avl-tree--stack-store avl-tree-stack)) + (avl-tree--stack-repopulate avl-tree-stack)) + (avl-tree--node-data node)))) + + +(defun avl-tree-stack-first (avl-tree-stack &optional nilflag) + "Return the first element of AVL-TREE-STACK, without removing it +from the stack. + +Returns nil if the stack is empty, or NILFLAG if specified. (The +latter allows an empty stack to be distinguished from a null +element stored in the AVL tree.)" + (or (car (avl-tree--stack-store avl-tree-stack)) + nilflag)) + + +(defun avl-tree-stack-empty-p (avl-tree-stack) + "Return t if AVL-TREE-STACK is empty, nil otherwise." + (null (avl-tree--stack-store avl-tree-stack))) + + (provide 'avl-tree) ;;; avl-tree.el ends here ------------------------------------------------------------ revno: 104391 committer: Eli Zaretskii branch nick: trunk timestamp: Sat 2011-05-28 00:24:11 +0300 message: src/ccl.c: Fix last commit. diff: === modified file 'src/ccl.c' --- src/ccl.c 2011-05-23 06:58:38 +0000 +++ src/ccl.c 2011-05-27 21:24:11 +0000 @@ -27,6 +27,7 @@ #include #include +#include #include "lisp.h" #include "character.h" ------------------------------------------------------------ revno: 104390 [merge] fixes bug(s): http://debbugs.gnu.org/8722 http://debbugs.gnu.org/8719 http://debbugs.gnu.org/8668 committer: Paul Eggert branch nick: trunk timestamp: Fri 2011-05-27 13:32:41 -0700 message: Merge: Integer overflow fixes. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-05-27 19:39:18 +0000 +++ src/ChangeLog 2011-05-27 19:58:54 +0000 @@ -1,3 +1,85 @@ +2011-05-27 Paul Eggert + + Integer overflow fixes. + + * dbusbind.c: Serial number integer overflow fixes. + (CHECK_DBUS_SERIAL_GET_SERIAL): New macro. + (Fdbus_call_method_asynchronously, xd_read_message_1): Use a float + to hold a serial number that is too large for a fixnum. + (Fdbus_method_return_internal, Fdbus_method_error_internal): + Check for serial numbers out of range. Decode any serial number + that was so large that it became a float. (Bug#8722) + + * dbusbind.c: Use XFASTINT rather than XUINT, and check for nonneg. + (Fdbus_call_method, Fdbus_call_method_asynchronously): + Use XFASTINT rather than XUINT when numbers are nonnegative. + (xd_append_arg, Fdbus_method_return_internal): + (Fdbus_method_error_internal): Likewise. Also, for unsigned + arguments, check that Lisp number is nonnegative, rather than + silently wrapping negative numbers around. (Bug#8722) + (xd_read_message_1): Don't assume dbus_uint32_t can fit in int. + (Bug#8722) + + * data.c (arith_driver, Flsh): Avoid unnecessary casts to EMACS_UINT. + + * ccl.c (ccl_driver): Redo slightly to avoid the need for 'unsigned'. + + ccl: add integer overflow checks + * ccl.c (CCL_CODE_MAX, GET_CCL_RANGE, GET_CCL_CODE, GET_CCL_INT): + (IN_INT_RANGE): New macros. + (ccl_driver): Use them to check for integer overflow when + decoding a CCL program. Many of the new checks are whether XINT (x) + fits in int; it doesn't always, on 64-bit hosts. The new version + doesn't catch all possible integer overflows, but it's an + improvement. (Bug#8719) + + * alloc.c (make_event_array): Use XINT, not XUINT. + There's no need for unsigned here. + + * mem-limits.h (EXCEEDS_LISP_PTR) [!USE_LSB_TAG]: EMACS_UINT -> uintptr_t + This follows up to the 2011-05-06 change that substituted uintptr_t + for EMACS_INT. This case wasn't caught back then. + + Rework Fformat to avoid integer overflow issues. + * editfns.c: Include unconditionally, as it's everywhere + now (part of C89). Include . + (MAX_10_EXP, CONVERTED_BYTE_SIZE): Remove; no longer needed. + (pWIDE, pWIDElen, signed_wide, unsigned_wide): New defns. + (Fformat): Avoid the prepass trying to compute sizes; it was only + approximate and thus did not catch overflow reliably. Instead, walk + through the format just once, formatting and computing sizes as we go, + checking for integer overflow at every step, and allocating a larger + buffer as needed. Keep track separately whether the format is + multibyte. Keep only the most-recently calculated precision, rather + than them all. Record whether each argument has been converted to + string. Use EMACS_INT, not int, for byte and char and arg counts. + Support field widths and precisions larger than INT_MAX. Avoid + sprintf's undefined behavior with conversion specifications such as %#d + and %.0c. Fix bug with strchr succeeding on '\0' when looking for + flags. Fix bug with (format "%c" 256.0). Avoid integer overflow when + formatting out-of-range floating point numbers with int + formats. (Bug#8668) + + * lisp.h (FIXNUM_OVERFLOW_P): Work even if arg is a NaN. + + * data.c: Avoid integer truncation in expressions involving floats. + * data.c: Include . + (arith_driver): When there's an integer overflow in an expression + involving floating point, convert the integers to floating point + so that the resulting value does not suffer from catastrophic + integer truncation. For example, on a 64-bit host (* 4 + most-negative-fixnum 0.5) should yield about -4.6e+18, not zero. + Do not rely on undefined behavior after integer overflow. + + merge count_size_as_multibyte, parse_str_to_multibyte + * character.c, character.h (count_size_as_multibyte): + Renamed from parse_str_to_multibyte; all uses changed. + Check for integer overflow. + * insdel.c, lisp.h (count_size_as_multibyte): Remove, + since it's now a duplicate of the other. This is more of + a character than a buffer op, so better that it's in character.c. + * fns.c, print.c: Adjust to above changes. + 2011-05-27 Stefan Monnier * xselect.c (x_convert_selection): Yet another int/Lisp_Object mixup. === modified file 'src/alloc.c' --- src/alloc.c 2011-05-16 01:11:54 +0000 +++ src/alloc.c 2011-05-23 00:31:35 +0000 @@ -3244,7 +3244,7 @@ are characters that are in 0...127, after discarding the meta bit and all the bits above it. */ if (!INTEGERP (args[i]) - || (XUINT (args[i]) & ~(-CHAR_META)) >= 0200) + || (XINT (args[i]) & ~(-CHAR_META)) >= 0200) return Fvector (nargs, args); /* Since the loop exited, we know that all the things in it are === modified file 'src/ccl.c' --- src/ccl.c 2011-05-12 07:07:06 +0000 +++ src/ccl.c 2011-05-23 06:58:38 +0000 @@ -98,6 +98,8 @@ and `rrr' are CCL register number, `XXXXX' is one of the following CCL commands. */ +#define CCL_CODE_MAX ((1 << (28 - 1)) - 1) + /* CCL commands Each comment fields shows one or more lines for command syntax and @@ -742,6 +744,24 @@ #endif +#define GET_CCL_RANGE(var, ccl_prog, ic, lo, hi) \ + do \ + { \ + EMACS_INT prog_word = XINT ((ccl_prog)[ic]); \ + if (! ((lo) <= prog_word && prog_word <= (hi))) \ + CCL_INVALID_CMD; \ + (var) = prog_word; \ + } \ + while (0) + +#define GET_CCL_CODE(code, ccl_prog, ic) \ + GET_CCL_RANGE (code, ccl_prog, ic, 0, CCL_CODE_MAX) + +#define GET_CCL_INT(var, ccl_prog, ic) \ + GET_CCL_RANGE (var, ccl_prog, ic, INT_MIN, INT_MAX) + +#define IN_INT_RANGE(val) (INT_MIN <= (val) && (val) <= INT_MAX) + /* Encode one character CH to multibyte form and write to the current output buffer. If CH is less than 256, CH is written as is. */ #define CCL_WRITE_CHAR(ch) \ @@ -899,7 +919,7 @@ } this_ic = ic; - code = XINT (ccl_prog[ic]); ic++; + GET_CCL_CODE (code, ccl_prog, ic++); field1 = code >> 8; field2 = (code & 0xFF) >> 5; @@ -920,15 +940,14 @@ break; case CCL_SetConst: /* 00000000000000000000rrrXXXXX */ - reg[rrr] = XINT (ccl_prog[ic]); - ic++; + GET_CCL_INT (reg[rrr], ccl_prog, ic++); break; case CCL_SetArray: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */ i = reg[RRR]; j = field1 >> 3; - if ((unsigned int) i < j) - reg[rrr] = XINT (ccl_prog[ic + i]); + if (0 <= i && i < j) + GET_CCL_INT (reg[rrr], ccl_prog, ic + i); ic += j; break; @@ -956,13 +975,13 @@ break; case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */ - i = XINT (ccl_prog[ic]); + GET_CCL_INT (i, ccl_prog, ic); CCL_WRITE_CHAR (i); ic += ADDR; break; case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */ - i = XINT (ccl_prog[ic]); + GET_CCL_INT (i, ccl_prog, ic); CCL_WRITE_CHAR (i); ic++; CCL_READ_CHAR (reg[rrr]); @@ -970,18 +989,17 @@ break; case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */ - j = XINT (ccl_prog[ic]); - ic++; + GET_CCL_INT (j, ccl_prog, ic++); CCL_WRITE_STRING (j); ic += ADDR - 1; break; case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */ i = reg[rrr]; - j = XINT (ccl_prog[ic]); - if ((unsigned int) i < j) + GET_CCL_INT (j, ccl_prog, ic); + if (0 <= i && i < j) { - i = XINT (ccl_prog[ic + 1 + i]); + GET_CCL_INT (i, ccl_prog, ic + 1 + i); CCL_WRITE_CHAR (i); } ic += j + 2; @@ -998,10 +1016,14 @@ CCL_READ_CHAR (reg[rrr]); /* fall through ... */ case CCL_Branch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */ - if ((unsigned int) reg[rrr] < field1) - ic += XINT (ccl_prog[ic + reg[rrr]]); - else - ic += XINT (ccl_prog[ic + field1]); + { + int incr; + GET_CCL_INT (incr, ccl_prog, + ic + (0 <= reg[rrr] && reg[rrr] < field1 + ? reg[rrr] + : field1)); + ic += incr; + } break; case CCL_ReadRegister: /* CCCCCCCCCCCCCCCCCCCCrrXXXXX */ @@ -1009,7 +1031,7 @@ { CCL_READ_CHAR (reg[rrr]); if (!field1) break; - code = XINT (ccl_prog[ic]); ic++; + GET_CCL_CODE (code, ccl_prog, ic++); field1 = code >> 8; field2 = (code & 0xFF) >> 5; } @@ -1018,7 +1040,7 @@ case CCL_WriteExprConst: /* 1:00000OPERATION000RRR000XXXXX */ rrr = 7; i = reg[RRR]; - j = XINT (ccl_prog[ic]); + GET_CCL_INT (j, ccl_prog, ic); op = field1 >> 6; jump_address = ic + 1; goto ccl_set_expr; @@ -1029,7 +1051,7 @@ i = reg[rrr]; CCL_WRITE_CHAR (i); if (!field1) break; - code = XINT (ccl_prog[ic]); ic++; + GET_CCL_CODE (code, ccl_prog, ic++); field1 = code >> 8; field2 = (code & 0xFF) >> 5; } @@ -1051,10 +1073,7 @@ /* If FFF is nonzero, the CCL program ID is in the following code. */ if (rrr) - { - prog_id = XINT (ccl_prog[ic]); - ic++; - } + GET_CCL_INT (prog_id, ccl_prog, ic++); else prog_id = field1; @@ -1095,9 +1114,9 @@ case CCL_WriteArray: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */ i = reg[rrr]; - if ((unsigned int) i < field1) + if (0 <= i && i < field1) { - j = XINT (ccl_prog[ic + i]); + GET_CCL_INT (j, ccl_prog, ic + i); CCL_WRITE_CHAR (j); } ic += field1; @@ -1122,8 +1141,7 @@ CCL_SUCCESS; case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */ - i = XINT (ccl_prog[ic]); - ic++; + GET_CCL_INT (i, ccl_prog, ic++); op = field1 >> 6; goto ccl_expr_self; @@ -1159,9 +1177,9 @@ case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */ i = reg[RRR]; - j = XINT (ccl_prog[ic]); + GET_CCL_INT (j, ccl_prog, ic++); op = field1 >> 6; - jump_address = ++ic; + jump_address = ic; goto ccl_set_expr; case CCL_SetExprReg: /* 00000OPERATIONRrrRRRrrrXXXXX */ @@ -1175,10 +1193,9 @@ CCL_READ_CHAR (reg[rrr]); case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */ i = reg[rrr]; - op = XINT (ccl_prog[ic]); - jump_address = ic++ + ADDR; - j = XINT (ccl_prog[ic]); - ic++; + jump_address = ic + ADDR; + GET_CCL_INT (op, ccl_prog, ic++); + GET_CCL_INT (j, ccl_prog, ic++); rrr = 7; goto ccl_set_expr; @@ -1186,10 +1203,10 @@ CCL_READ_CHAR (reg[rrr]); case CCL_JumpCondExprReg: i = reg[rrr]; - op = XINT (ccl_prog[ic]); - jump_address = ic++ + ADDR; - j = reg[XINT (ccl_prog[ic])]; - ic++; + jump_address = ic + ADDR; + GET_CCL_INT (op, ccl_prog, ic++); + GET_CCL_RANGE (j, ccl_prog, ic++, 0, 7); + j = reg[j]; rrr = 7; ccl_set_expr: @@ -1267,18 +1284,27 @@ break; case CCL_TranslateCharacterConstTbl: - op = XINT (ccl_prog[ic]); /* table */ - ic++; - i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]); - op = translate_char (GET_TRANSLATION_TABLE (op), i); - CCL_ENCODE_CHAR (op, charset_list, reg[RRR], reg[rrr]); + { + EMACS_INT eop; + GET_CCL_RANGE (eop, ccl_prog, ic++, 0, + (VECTORP (Vtranslation_table_vector) + ? ASIZE (Vtranslation_table_vector) + : -1)); + i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]); + op = translate_char (GET_TRANSLATION_TABLE (eop), i); + CCL_ENCODE_CHAR (op, charset_list, reg[RRR], reg[rrr]); + } break; case CCL_LookupIntConstTbl: - op = XINT (ccl_prog[ic]); /* table */ - ic++; { - struct Lisp_Hash_Table *h = GET_HASH_TABLE (op); + EMACS_INT eop; + struct Lisp_Hash_Table *h; + GET_CCL_RANGE (eop, ccl_prog, ic++, 0, + (VECTORP (Vtranslation_hash_table_vector) + ? ASIZE (Vtranslation_hash_table_vector) + : -1)); + h = GET_HASH_TABLE (eop); op = hash_lookup (h, make_number (reg[RRR]), NULL); if (op >= 0) @@ -1297,18 +1323,22 @@ break; case CCL_LookupCharConstTbl: - op = XINT (ccl_prog[ic]); /* table */ - ic++; - i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]); { - struct Lisp_Hash_Table *h = GET_HASH_TABLE (op); + EMACS_INT eop; + struct Lisp_Hash_Table *h; + GET_CCL_RANGE (eop, ccl_prog, ic++, 0, + (VECTORP (Vtranslation_hash_table_vector) + ? ASIZE (Vtranslation_hash_table_vector) + : -1)); + i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]); + h = GET_HASH_TABLE (eop); op = hash_lookup (h, make_number (i), NULL); if (op >= 0) { Lisp_Object opl; opl = HASH_VALUE (h, op); - if (!INTEGERP (opl)) + if (! (INTEGERP (opl) && IN_INT_RANGE (XINT (opl)))) CCL_INVALID_CMD; reg[RRR] = XINT (opl); reg[7] = 1; /* r7 true for success */ @@ -1321,9 +1351,10 @@ case CCL_IterateMultipleMap: { Lisp_Object map, content, attrib, value; - int point, size, fin_ic; + EMACS_INT point, size; + int fin_ic; - j = XINT (ccl_prog[ic++]); /* number of maps. */ + GET_CCL_INT (j, ccl_prog, ic++); /* number of maps. */ fin_ic = ic + j; op = reg[rrr]; if ((j > reg[RRR]) && (j >= 0)) @@ -1343,7 +1374,7 @@ size = ASIZE (Vcode_conversion_map_vector); point = XINT (ccl_prog[ic++]); - if (point >= size) continue; + if (! (0 <= point && point < size)) continue; map = AREF (Vcode_conversion_map_vector, point); /* Check map validity. */ @@ -1358,18 +1389,19 @@ /* check map type, [STARTPOINT VAL1 VAL2 ...] or [t ELEMENT STARTPOINT ENDPOINT] */ - if (NUMBERP (content)) + if (INTEGERP (content)) { - point = XUINT (content); - point = op - point + 1; - if (!((point >= 1) && (point < size))) continue; - content = AREF (map, point); + point = XINT (content); + if (!(point <= op && op - point + 1 < size)) continue; + content = AREF (map, op - point + 1); } else if (EQ (content, Qt)) { if (size != 4) continue; - if ((op >= XUINT (AREF (map, 2))) - && (op < XUINT (AREF (map, 3)))) + if (INTEGERP (AREF (map, 2)) + && XINT (AREF (map, 2)) <= op + && INTEGERP (AREF (map, 3)) + && op < XINT (AREF (map, 3))) content = AREF (map, 1); else continue; @@ -1379,7 +1411,7 @@ if (NILP (content)) continue; - else if (NUMBERP (content)) + else if (INTEGERP (content) && IN_INT_RANGE (XINT (content))) { reg[RRR] = i; reg[rrr] = XINT(content); @@ -1394,10 +1426,11 @@ { attrib = XCAR (content); value = XCDR (content); - if (!NUMBERP (attrib) || !NUMBERP (value)) + if (! (INTEGERP (attrib) && INTEGERP (value) + && IN_INT_RANGE (XINT (value)))) continue; reg[RRR] = i; - reg[rrr] = XUINT (value); + reg[rrr] = XINT (value); break; } else if (SYMBOLP (content)) @@ -1432,8 +1465,9 @@ mapping_stack_pointer = mapping_stack; stack_idx_of_map_multiple = 0; - map_set_rest_length = - XINT (ccl_prog[ic++]); /* number of maps and separators. */ + /* Get number of maps and separators. */ + GET_CCL_INT (map_set_rest_length, ccl_prog, ic++); + fin_ic = ic + map_set_rest_length; op = reg[rrr]; @@ -1501,7 +1535,7 @@ do { for (;map_set_rest_length > 0;i++, ic++, map_set_rest_length--) { - point = XINT(ccl_prog[ic]); + GET_CCL_INT (point, ccl_prog, ic); if (point < 0) { /* +1 is for including separator. */ @@ -1531,18 +1565,19 @@ /* check map type, [STARTPOINT VAL1 VAL2 ...] or [t ELEMENT STARTPOINT ENDPOINT] */ - if (NUMBERP (content)) + if (INTEGERP (content)) { - point = XUINT (content); - point = op - point + 1; - if (!((point >= 1) && (point < size))) continue; - content = AREF (map, point); + point = XINT (content); + if (!(point <= op && op - point + 1 < size)) continue; + content = AREF (map, op - point + 1); } else if (EQ (content, Qt)) { if (size != 4) continue; - if ((op >= XUINT (AREF (map, 2))) && - (op < XUINT (AREF (map, 3)))) + if (INTEGERP (AREF (map, 2)) + && XINT (AREF (map, 2)) <= op + && INTEGERP (AREF (map, 3)) + && op < XINT (AREF (map, 3))) content = AREF (map, 1); else continue; @@ -1554,7 +1589,7 @@ continue; reg[RRR] = i; - if (NUMBERP (content)) + if (INTEGERP (content) && IN_INT_RANGE (XINT (content))) { op = XINT (content); i += map_set_rest_length - 1; @@ -1566,9 +1601,10 @@ { attrib = XCAR (content); value = XCDR (content); - if (!NUMBERP (attrib) || !NUMBERP (value)) + if (! (INTEGERP (attrib) && INTEGERP (value) + && IN_INT_RANGE (XINT (value)))) continue; - op = XUINT (value); + op = XINT (value); i += map_set_rest_length - 1; ic += map_set_rest_length - 1; POP_MAPPING_STACK (map_set_rest_length, reg[rrr]); @@ -1613,7 +1649,7 @@ case CCL_MapSingle: { Lisp_Object map, attrib, value, content; - int size, point; + int point; j = XINT (ccl_prog[ic++]); /* map_id */ op = reg[rrr]; if (j >= ASIZE (Vcode_conversion_map_vector)) @@ -1628,41 +1664,36 @@ break; } map = XCDR (map); - if (!VECTORP (map)) + if (! (VECTORP (map) + && INTEGERP (AREF (map, 0)) + && XINT (AREF (map, 0)) <= op + && op - XINT (AREF (map, 0)) + 1 < ASIZE (map))) { reg[RRR] = -1; break; } - size = ASIZE (map); - point = XUINT (AREF (map, 0)); + point = XINT (AREF (map, 0)); point = op - point + 1; reg[RRR] = 0; - if ((size <= 1) || - (!((point >= 1) && (point < size)))) + content = AREF (map, point); + if (NILP (content)) reg[RRR] = -1; - else + else if (INTEGERP (content)) + reg[rrr] = XINT (content); + else if (EQ (content, Qt)); + else if (CONSP (content)) { - reg[RRR] = 0; - content = AREF (map, point); - if (NILP (content)) - reg[RRR] = -1; - else if (NUMBERP (content)) - reg[rrr] = XINT (content); - else if (EQ (content, Qt)); - else if (CONSP (content)) - { - attrib = XCAR (content); - value = XCDR (content); - if (!NUMBERP (attrib) || !NUMBERP (value)) - continue; - reg[rrr] = XUINT(value); - break; - } - else if (SYMBOLP (content)) - CCL_CALL_FOR_MAP_INSTRUCTION (content, ic); - else - reg[RRR] = -1; + attrib = XCAR (content); + value = XCDR (content); + if (!INTEGERP (attrib) || !INTEGERP (value)) + continue; + reg[rrr] = XINT(value); + break; } + else if (SYMBOLP (content)) + CCL_CALL_FOR_MAP_INSTRUCTION (content, ic); + else + reg[RRR] = -1; } break; === modified file 'src/character.c' --- src/character.c 2011-05-16 05:18:38 +0000 +++ src/character.c 2011-05-21 04:33:23 +0000 @@ -672,13 +672,18 @@ `str_to_multibyte'. */ EMACS_INT -parse_str_to_multibyte (const unsigned char *str, EMACS_INT len) +count_size_as_multibyte (const unsigned char *str, EMACS_INT len) { const unsigned char *endp = str + len; EMACS_INT bytes; for (bytes = 0; str < endp; str++) - bytes += (*str < 0x80) ? 1 : 2; + { + int n = *str < 0x80 ? 1 : 2; + if (INT_ADD_OVERFLOW (bytes, n)) + string_overflow (); + bytes += n; + } return bytes; } === modified file 'src/character.h' --- src/character.h 2011-05-16 05:08:59 +0000 +++ src/character.h 2011-05-21 04:33:23 +0000 @@ -602,7 +602,7 @@ extern int char_printable_p (int c); extern void parse_str_as_multibyte (const unsigned char *, EMACS_INT, EMACS_INT *, EMACS_INT *); -extern EMACS_INT parse_str_to_multibyte (const unsigned char *, EMACS_INT); +extern EMACS_INT count_size_as_multibyte (const unsigned char *, EMACS_INT); extern EMACS_INT str_as_multibyte (unsigned char *, EMACS_INT, EMACS_INT, EMACS_INT *); extern EMACS_INT str_to_multibyte (unsigned char *, EMACS_INT, EMACS_INT); === modified file 'src/data.c' --- src/data.c 2011-05-12 07:07:06 +0000 +++ src/data.c 2011-05-27 19:48:22 +0000 @@ -22,6 +22,9 @@ #include #include #include + +#include + #include "lisp.h" #include "puresize.h" #include "character.h" @@ -2431,6 +2434,10 @@ register EMACS_INT accum = 0; register EMACS_INT next; + int overflow = 0; + size_t ok_args; + EMACS_INT ok_accum; + switch (SWITCH_ENUM_CAST (code)) { case Alogior: @@ -2451,25 +2458,48 @@ for (argnum = 0; argnum < nargs; argnum++) { + if (! overflow) + { + ok_args = argnum; + ok_accum = accum; + } + /* Using args[argnum] as argument to CHECK_NUMBER_... */ val = args[argnum]; CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val); if (FLOATP (val)) - return float_arith_driver ((double) accum, argnum, code, + return float_arith_driver (ok_accum, ok_args, code, nargs, args); args[argnum] = val; next = XINT (args[argnum]); switch (SWITCH_ENUM_CAST (code)) { case Aadd: + if (INT_ADD_OVERFLOW (accum, next)) + { + overflow = 1; + accum &= INTMASK; + } accum += next; break; case Asub: + if (INT_SUBTRACT_OVERFLOW (accum, next)) + { + overflow = 1; + accum &= INTMASK; + } accum = argnum ? accum - next : nargs == 1 ? - next : next; break; case Amult: - accum *= next; + if (INT_MULTIPLY_OVERFLOW (accum, next)) + { + EMACS_UINT a = accum, b = next, ab = a * b; + overflow = 1; + accum = ab & INTMASK; + } + else + accum *= next; break; case Adiv: if (!argnum) @@ -2760,11 +2790,11 @@ if (XINT (count) >= BITS_PER_EMACS_INT) XSETINT (val, 0); else if (XINT (count) > 0) - XSETINT (val, (EMACS_UINT) XUINT (value) << XFASTINT (count)); + XSETINT (val, XUINT (value) << XFASTINT (count)); else if (XINT (count) <= -BITS_PER_EMACS_INT) XSETINT (val, 0); else - XSETINT (val, (EMACS_UINT) XUINT (value) >> -XINT (count)); + XSETINT (val, XUINT (value) >> -XINT (count)); return val; } === modified file 'src/dbusbind.c' --- src/dbusbind.c 2011-05-06 22:12:31 +0000 +++ src/dbusbind.c 2011-05-24 07:41:16 +0000 @@ -242,6 +242,24 @@ #define XD_NEXT_VALUE(object) \ ((XD_DBUS_TYPE_P (CAR_SAFE (object))) ? CDR_SAFE (object) : object) +/* Check whether X is a valid dbus serial number. If valid, set + SERIAL to its value. Otherwise, signal an error. */ +#define CHECK_DBUS_SERIAL_GET_SERIAL(x, serial) \ + do \ + { \ + dbus_uint32_t DBUS_SERIAL_MAX = -1; \ + if (NATNUMP (x) && XINT (x) <= DBUS_SERIAL_MAX) \ + serial = XINT (x); \ + else if (MOST_POSITIVE_FIXNUM < DBUS_SERIAL_MAX \ + && FLOATP (x) \ + && 0 <= XFLOAT_DATA (x) \ + && XFLOAT_DATA (x) <= DBUS_SERIAL_MAX) \ + serial = XFLOAT_DATA (x); \ + else \ + XD_SIGNAL2 (build_string ("Invalid dbus serial"), x); \ + } \ + while (0) + /* Compute SIGNATURE of OBJECT. It must have a form that it can be used in dbus_message_iter_open_container. DTYPE is the DBusType the object is related to. It is passed as argument, because it @@ -431,9 +449,9 @@ switch (dtype) { case DBUS_TYPE_BYTE: - CHECK_NUMBER (object); + CHECK_NATNUM (object); { - unsigned char val = XUINT (object) & 0xFF; + unsigned char val = XFASTINT (object) & 0xFF; XD_DEBUG_MESSAGE ("%c %d", dtype, val); if (!dbus_message_iter_append_basic (iter, dtype, &val)) XD_SIGNAL2 (build_string ("Unable to append argument"), object); @@ -460,9 +478,9 @@ } case DBUS_TYPE_UINT16: - CHECK_NUMBER (object); + CHECK_NATNUM (object); { - dbus_uint16_t val = XUINT (object); + dbus_uint16_t val = XFASTINT (object); XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val); if (!dbus_message_iter_append_basic (iter, dtype, &val)) XD_SIGNAL2 (build_string ("Unable to append argument"), object); @@ -483,9 +501,9 @@ #ifdef DBUS_TYPE_UNIX_FD case DBUS_TYPE_UNIX_FD: #endif - CHECK_NUMBER (object); + CHECK_NATNUM (object); { - dbus_uint32_t val = XUINT (object); + dbus_uint32_t val = XFASTINT (object); XD_DEBUG_MESSAGE ("%c %u", dtype, val); if (!dbus_message_iter_append_basic (iter, dtype, &val)) XD_SIGNAL2 (build_string ("Unable to append argument"), object); @@ -503,10 +521,10 @@ } case DBUS_TYPE_UINT64: - CHECK_NUMBER (object); + CHECK_NATNUM (object); { - dbus_uint64_t val = XUINT (object); - XD_DEBUG_MESSAGE ("%c %"pI"u", dtype, XUINT (object)); + dbus_uint64_t val = XFASTINT (object); + XD_DEBUG_MESSAGE ("%c %"pI"d", dtype, XFASTINT (object)); if (!dbus_message_iter_append_basic (iter, dtype, &val)) XD_SIGNAL2 (build_string ("Unable to append argument"), object); return; @@ -1110,7 +1128,7 @@ if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout))) { CHECK_NATNUM (args[i+1]); - timeout = XUINT (args[i+1]); + timeout = XFASTINT (args[i+1]); i = i+2; } @@ -1186,7 +1204,7 @@ /* Return the result. If there is only one single Lisp object, return it as-it-is, otherwise return the reversed list. */ - if (XUINT (Flength (result)) == 1) + if (XFASTINT (Flength (result)) == 1) RETURN_UNGCPRO (CAR_SAFE (result)); else RETURN_UNGCPRO (Fnreverse (result)); @@ -1251,6 +1269,7 @@ DBusMessage *dmessage; DBusMessageIter iter; unsigned int dtype; + dbus_uint32_t serial; int timeout = -1; size_t i = 6; char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH]; @@ -1292,7 +1311,7 @@ if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout))) { CHECK_NATNUM (args[i+1]); - timeout = XUINT (args[i+1]); + timeout = XFASTINT (args[i+1]); i = i+2; } @@ -1335,7 +1354,8 @@ XD_SIGNAL1 (build_string ("Cannot send message")); /* The result is the key in Vdbus_registered_objects_table. */ - result = (list2 (bus, make_number (dbus_message_get_serial (dmessage)))); + serial = dbus_message_get_serial (dmessage); + result = list2 (bus, make_fixnum_or_float (serial)); /* Create a hash table entry. */ Fputhash (result, handler, Vdbus_registered_objects_table); @@ -1368,25 +1388,26 @@ usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */) (size_t nargs, register Lisp_Object *args) { - Lisp_Object bus, serial, service; - struct gcpro gcpro1, gcpro2, gcpro3; + Lisp_Object bus, service; + struct gcpro gcpro1, gcpro2; DBusConnection *connection; DBusMessage *dmessage; DBusMessageIter iter; - unsigned int dtype; + dbus_uint32_t serial; + unsigned int ui_serial, dtype; size_t i; char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH]; /* Check parameters. */ bus = args[0]; - serial = args[1]; service = args[2]; - CHECK_NUMBER (serial); + CHECK_DBUS_SERIAL_GET_SERIAL (args[1], serial); CHECK_STRING (service); - GCPRO3 (bus, serial, service); + GCPRO2 (bus, service); - XD_DEBUG_MESSAGE ("%"pI"u %s ", XUINT (serial), SDATA (service)); + ui_serial = serial; + XD_DEBUG_MESSAGE ("%u %s ", ui_serial, SSDATA (service)); /* Open a connection to the bus. */ connection = xd_initialize (bus, TRUE); @@ -1394,7 +1415,7 @@ /* Create the message. */ dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_METHOD_RETURN); if ((dmessage == NULL) - || (!dbus_message_set_reply_serial (dmessage, XUINT (serial))) + || (!dbus_message_set_reply_serial (dmessage, serial)) || (!dbus_message_set_destination (dmessage, SSDATA (service)))) { UNGCPRO; @@ -1456,25 +1477,26 @@ usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */) (size_t nargs, register Lisp_Object *args) { - Lisp_Object bus, serial, service; - struct gcpro gcpro1, gcpro2, gcpro3; + Lisp_Object bus, service; + struct gcpro gcpro1, gcpro2; DBusConnection *connection; DBusMessage *dmessage; DBusMessageIter iter; - unsigned int dtype; + dbus_uint32_t serial; + unsigned int ui_serial, dtype; size_t i; char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH]; /* Check parameters. */ bus = args[0]; - serial = args[1]; service = args[2]; - CHECK_NUMBER (serial); + CHECK_DBUS_SERIAL_GET_SERIAL (args[1], serial); CHECK_STRING (service); - GCPRO3 (bus, serial, service); + GCPRO2 (bus, service); - XD_DEBUG_MESSAGE ("%"pI"u %s ", XUINT (serial), SDATA (service)); + ui_serial = serial; + XD_DEBUG_MESSAGE ("%u %s ", ui_serial, SSDATA (service)); /* Open a connection to the bus. */ connection = xd_initialize (bus, TRUE); @@ -1483,7 +1505,7 @@ dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_ERROR); if ((dmessage == NULL) || (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED)) - || (!dbus_message_set_reply_serial (dmessage, XUINT (serial))) + || (!dbus_message_set_reply_serial (dmessage, serial)) || (!dbus_message_set_destination (dmessage, SSDATA (service)))) { UNGCPRO; @@ -1663,7 +1685,9 @@ DBusMessage *dmessage; DBusMessageIter iter; unsigned int dtype; - int mtype, serial; + int mtype; + dbus_uint32_t serial; + unsigned int ui_serial; const char *uname, *path, *interface, *member; dmessage = dbus_connection_pop_message (connection); @@ -1692,7 +1716,7 @@ /* Read message type, message serial, unique name, object path, interface and member from the message. */ mtype = dbus_message_get_type (dmessage); - serial = + ui_serial = serial = ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN) || (mtype == DBUS_MESSAGE_TYPE_ERROR)) ? dbus_message_get_reply_serial (dmessage) @@ -1702,7 +1726,7 @@ interface = dbus_message_get_interface (dmessage); member = dbus_message_get_member (dmessage); - XD_DEBUG_MESSAGE ("Event received: %s %d %s %s %s %s %s", + XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s", (mtype == DBUS_MESSAGE_TYPE_INVALID) ? "DBUS_MESSAGE_TYPE_INVALID" : (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) @@ -1712,14 +1736,14 @@ : (mtype == DBUS_MESSAGE_TYPE_ERROR) ? "DBUS_MESSAGE_TYPE_ERROR" : "DBUS_MESSAGE_TYPE_SIGNAL", - serial, uname, path, interface, member, + ui_serial, uname, path, interface, member, SDATA (format2 ("%s", args, Qnil))); if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN) || (mtype == DBUS_MESSAGE_TYPE_ERROR)) { /* Search for a registered function of the message. */ - key = list2 (bus, make_number (serial)); + key = list2 (bus, make_fixnum_or_float (serial)); value = Fgethash (key, Vdbus_registered_objects_table, Qnil); /* There shall be exactly one entry. Construct an event. */ @@ -1785,7 +1809,7 @@ event.arg); event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)), event.arg); - event.arg = Fcons (make_number (serial), event.arg); + event.arg = Fcons (make_fixnum_or_float (serial), event.arg); event.arg = Fcons (make_number (mtype), event.arg); /* Add the bus symbol to the event. */ === modified file 'src/editfns.c' --- src/editfns.c 2011-05-26 05:36:55 +0000 +++ src/editfns.c 2011-05-27 19:37:32 +0000 @@ -45,9 +45,11 @@ #endif #include +#include #include #include #include +#include #include "intervals.h" #include "buffer.h" @@ -57,13 +59,6 @@ #include "window.h" #include "blockinput.h" -#ifdef STDC_HEADERS -#include -#define MAX_10_EXP DBL_MAX_10_EXP -#else -#define MAX_10_EXP 310 -#endif - #ifndef NULL #define NULL 0 #endif @@ -3525,14 +3520,21 @@ RETURN_UNGCPRO (string); } - -/* Number of bytes that STRING will occupy when put into the result. - MULTIBYTE is nonzero if the result should be multibyte. */ - -#define CONVERTED_BYTE_SIZE(MULTIBYTE, STRING) \ - (((MULTIBYTE) && ! STRING_MULTIBYTE (STRING)) \ - ? count_size_as_multibyte (SDATA (STRING), SBYTES (STRING)) \ - : SBYTES (STRING)) +/* pWIDE is a conversion for printing large decimal integers (possibly with a + trailing "d" that is ignored). pWIDElen is its length. signed_wide and + unsigned_wide are signed and unsigned types for printing them. Use widest + integers if available so that more floating point values can be converted. */ +#ifdef PRIdMAX +# define pWIDE PRIdMAX +enum { pWIDElen = sizeof PRIdMAX - 2 }; /* Don't count trailing "d". */ +typedef intmax_t signed_wide; +typedef uintmax_t unsigned_wide; +#else +# define pWIDE pI +enum { pWIDElen = sizeof pI - 1 }; +typedef EMACS_INT signed_wide; +typedef EMACS_UINT unsigned_wide; +#endif DEFUN ("format", Fformat, Sformat, 1, MANY, 0, doc: /* Format a string out of a format-string and arguments. @@ -3583,11 +3585,17 @@ usage: (format STRING &rest OBJECTS) */) (size_t nargs, register Lisp_Object *args) { - register size_t n; /* The number of the next arg to substitute */ - register size_t total; /* An estimate of the final length */ - char *buf, *p; + EMACS_INT n; /* The number of the next arg to substitute */ + char initial_buffer[4000]; + char *buf = initial_buffer; + EMACS_INT bufsize = sizeof initial_buffer; + EMACS_INT max_bufsize = min (MOST_POSITIVE_FIXNUM + 1, SIZE_MAX); + char *p; + Lisp_Object buf_save_value IF_LINT (= {0}); register char *format, *end, *format_start; - int nchars; + EMACS_INT formatlen, nchars; + /* Nonzero if the format is multibyte. */ + int multibyte_format = 0; /* Nonzero if the output should be a multibyte string, which is true if any of the inputs is one. */ int multibyte = 0; @@ -3596,14 +3604,6 @@ multibyte character of the previous string. This flag tells if we must consider such a situation or not. */ int maybe_combine_byte; - char *this_format; - /* Precision for each spec, or -1, a flag value meaning no precision - was given in that spec. Element 0, corresponding to the format - string itself, will not be used. Element NARGS, corresponding to - no argument, *will* be assigned to in the case that a `%' and `.' - occur after the final format specifier. */ - int *precision = (int *) (alloca ((nargs + 1) * sizeof (int))); - int longest_format; Lisp_Object val; int arg_intervals = 0; USE_SAFE_ALLOCA; @@ -3611,458 +3611,603 @@ /* discarded[I] is 1 if byte I of the format string was not copied into the output. It is 2 if byte I was not the first byte of its character. */ - char *discarded = 0; + char *discarded; /* Each element records, for one argument, the start and end bytepos in the output string, + whether the argument has been converted to string (e.g., due to "%S"), and whether the argument is a string with intervals. info[0] is unused. Unused elements have -1 for start. */ struct info { - int start, end, intervals; + EMACS_INT start, end; + int converted_to_string; + int intervals; } *info = 0; /* It should not be necessary to GCPRO ARGS, because the caller in the interpreter should take care of that. */ + CHECK_STRING (args[0]); + format_start = SSDATA (args[0]); + formatlen = SBYTES (args[0]); + + /* Allocate the info and discarded tables. */ + { + EMACS_INT i; + if ((SIZE_MAX - formatlen) / sizeof (struct info) <= nargs) + memory_full (); + SAFE_ALLOCA (info, struct info *, (nargs + 1) * sizeof *info + formatlen); + discarded = (char *) &info[nargs + 1]; + for (i = 0; i < nargs + 1; i++) + { + info[i].start = -1; + info[i].intervals = info[i].converted_to_string = 0; + } + memset (discarded, 0, formatlen); + } + /* Try to determine whether the result should be multibyte. This is not always right; sometimes the result needs to be multibyte because of an object that we will pass through prin1, and in that case, we won't know it here. */ - for (n = 0; n < nargs; n++) - { - if (STRINGP (args[n]) && STRING_MULTIBYTE (args[n])) - multibyte = 1; - /* Piggyback on this loop to initialize precision[N]. */ - precision[n] = -1; - } - precision[nargs] = -1; - - CHECK_STRING (args[0]); - /* We may have to change "%S" to "%s". */ - args[0] = Fcopy_sequence (args[0]); - - /* GC should never happen here, so abort if it does. */ - abort_on_gc++; + multibyte_format = STRING_MULTIBYTE (args[0]); + multibyte = multibyte_format; + for (n = 1; !multibyte && n < nargs; n++) + if (STRINGP (args[n]) && STRING_MULTIBYTE (args[n])) + multibyte = 1; /* If we start out planning a unibyte result, - then discover it has to be multibyte, we jump back to retry. - That can only happen from the first large while loop below. */ + then discover it has to be multibyte, we jump back to retry. */ retry: - format = SSDATA (args[0]); - format_start = format; - end = format + SBYTES (args[0]); - longest_format = 0; - - /* Make room in result for all the non-%-codes in the control string. */ - total = 5 + CONVERTED_BYTE_SIZE (multibyte, args[0]) + 1; - - /* Allocate the info and discarded tables. */ - { - size_t nbytes = (nargs+1) * sizeof *info; - size_t i; - if (!info) - info = (struct info *) alloca (nbytes); - memset (info, 0, nbytes); - for (i = 0; i < nargs + 1; i++) - info[i].start = -1; - if (!discarded) - SAFE_ALLOCA (discarded, char *, SBYTES (args[0])); - memset (discarded, 0, SBYTES (args[0])); - } - - /* Add to TOTAL enough space to hold the converted arguments. */ - - n = 0; - while (format != end) - if (*format++ == '%') - { - EMACS_INT thissize = 0; - EMACS_INT actual_width = 0; - char *this_format_start = format - 1; - int field_width = 0; - - /* General format specifications look like - - '%' [flags] [field-width] [precision] format - - where - - flags ::= [-+ #0]+ - field-width ::= [0-9]+ - precision ::= '.' [0-9]* - - If a field-width is specified, it specifies to which width - the output should be padded with blanks, if the output - string is shorter than field-width. - - If precision is specified, it specifies the number of - digits to print after the '.' for floats, or the max. - number of chars to print from a string. */ - - while (format != end - && (*format == '-' || *format == '0' || *format == '#' - || * format == ' ' || *format == '+')) - ++format; - - if (*format >= '0' && *format <= '9') - { - for (field_width = 0; *format >= '0' && *format <= '9'; ++format) - field_width = 10 * field_width + *format - '0'; - } - - /* N is not incremented for another few lines below, so refer to - element N+1 (which might be precision[NARGS]). */ - if (*format == '.') - { - ++format; - for (precision[n+1] = 0; *format >= '0' && *format <= '9'; ++format) - precision[n+1] = 10 * precision[n+1] + *format - '0'; - } - - /* Extra +1 for 'l' that we may need to insert into the - format. */ - if (format - this_format_start + 2 > longest_format) - longest_format = format - this_format_start + 2; - - if (format == end) - error ("Format string ends in middle of format specifier"); - if (*format == '%') - format++; - else if (++n >= nargs) - error ("Not enough arguments for format string"); - else if (*format == 'S') - { - /* For `S', prin1 the argument and then treat like a string. */ - register Lisp_Object tem; - tem = Fprin1_to_string (args[n], Qnil); - if (STRING_MULTIBYTE (tem) && ! multibyte) - { - multibyte = 1; - goto retry; - } - args[n] = tem; - /* If we restart the loop, we should not come here again - because args[n] is now a string and calling - Fprin1_to_string on it produces superflous double - quotes. So, change "%S" to "%s" now. */ - *format = 's'; - goto string; - } - else if (SYMBOLP (args[n])) - { - args[n] = SYMBOL_NAME (args[n]); - if (STRING_MULTIBYTE (args[n]) && ! multibyte) - { - multibyte = 1; - goto retry; - } - goto string; - } - else if (STRINGP (args[n])) - { - string: - if (*format != 's' && *format != 'S') - error ("Format specifier doesn't match argument type"); - /* In the case (PRECISION[N] > 0), THISSIZE may not need - to be as large as is calculated here. Easy check for - the case PRECISION = 0. */ - thissize = precision[n] ? CONVERTED_BYTE_SIZE (multibyte, args[n]) : 0; - /* The precision also constrains how much of the argument - string will finally appear (Bug#5710). */ - actual_width = lisp_string_width (args[n], -1, NULL, NULL); - if (precision[n] != -1) - actual_width = min (actual_width, precision[n]); - } - /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */ - else if (INTEGERP (args[n]) && *format != 's') - { - /* The following loop assumes the Lisp type indicates - the proper way to pass the argument. - So make sure we have a flonum if the argument should - be a double. */ - if (*format == 'e' || *format == 'f' || *format == 'g') - args[n] = Ffloat (args[n]); - else - if (*format != 'd' && *format != 'o' && *format != 'x' - && *format != 'i' && *format != 'X' && *format != 'c') - error ("Invalid format operation %%%c", *format); - - thissize = 30 + (precision[n] > 0 ? precision[n] : 0); - if (*format == 'c') - { - if (! ASCII_CHAR_P (XINT (args[n])) - /* Note: No one can remember why we have to treat - the character 0 as a multibyte character here. - But, until it causes a real problem, let's - don't change it. */ - || XINT (args[n]) == 0) - { - if (! multibyte) - { - multibyte = 1; - goto retry; - } - args[n] = Fchar_to_string (args[n]); - thissize = SBYTES (args[n]); - } - } - } - else if (FLOATP (args[n]) && *format != 's') - { - if (! (*format == 'e' || *format == 'f' || *format == 'g')) - { - if (*format != 'd' && *format != 'o' && *format != 'x' - && *format != 'i' && *format != 'X' && *format != 'c') - error ("Invalid format operation %%%c", *format); - /* This fails unnecessarily if args[n] is bigger than - most-positive-fixnum but smaller than MAXINT. - These cases are important because we sometimes use floats - to represent such integer values (typically such values - come from UIDs or PIDs). */ - /* args[n] = Ftruncate (args[n], Qnil); */ - } - - /* Note that we're using sprintf to print floats, - so we have to take into account what that function - prints. */ - /* Filter out flag value of -1. */ - thissize = (MAX_10_EXP + 100 - + (precision[n] > 0 ? precision[n] : 0)); - } - else - { - /* Anything but a string, convert to a string using princ. */ - register Lisp_Object tem; - tem = Fprin1_to_string (args[n], Qt); - if (STRING_MULTIBYTE (tem) && ! multibyte) - { - multibyte = 1; - goto retry; - } - args[n] = tem; - goto string; - } - - thissize += max (0, field_width - actual_width); - total += thissize + 4; - } - - abort_on_gc--; - - /* Now we can no longer jump to retry. - TOTAL and LONGEST_FORMAT are known for certain. */ - - this_format = (char *) alloca (longest_format + 1); - - /* Allocate the space for the result. - Note that TOTAL is an overestimate. */ - SAFE_ALLOCA (buf, char *, total); - p = buf; nchars = 0; n = 0; /* Scan the format and store result in BUF. */ - format = SSDATA (args[0]); - format_start = format; - end = format + SBYTES (args[0]); + format = format_start; + end = format + formatlen; maybe_combine_byte = 0; + while (format != end) { + /* The values of N and FORMAT when the loop body is entered. */ + EMACS_INT n0 = n; + char *format0 = format; + + /* Bytes needed to represent the output of this conversion. */ + EMACS_INT convbytes; + if (*format == '%') { - int minlen; - int negative = 0; - char *this_format_start = format; - + /* General format specifications look like + + '%' [flags] [field-width] [precision] format + + where + + flags ::= [-+0# ]+ + field-width ::= [0-9]+ + precision ::= '.' [0-9]* + + If a field-width is specified, it specifies to which width + the output should be padded with blanks, if the output + string is shorter than field-width. + + If precision is specified, it specifies the number of + digits to print after the '.' for floats, or the max. + number of chars to print from a string. */ + + int minus_flag = 0; + int plus_flag = 0; + int space_flag = 0; + int sharp_flag = 0; + int zero_flag = 0; + EMACS_INT field_width; + int precision_given; + uintmax_t precision = UINTMAX_MAX; + char *num_end; + char conversion; + + while (1) + { + switch (*++format) + { + case '-': minus_flag = 1; continue; + case '+': plus_flag = 1; continue; + case ' ': space_flag = 1; continue; + case '#': sharp_flag = 1; continue; + case '0': zero_flag = 1; continue; + } + break; + } + + /* Ignore flags when sprintf ignores them. */ + space_flag &= ~ plus_flag; + zero_flag &= ~ minus_flag; + + { + uintmax_t w = strtoumax (format, &num_end, 10); + if (max_bufsize <= w) + string_overflow (); + field_width = w; + } + precision_given = *num_end == '.'; + if (precision_given) + precision = strtoumax (num_end + 1, &num_end, 10); + format = num_end; + + if (format == end) + error ("Format string ends in middle of format specifier"); + + memset (&discarded[format0 - format_start], 1, format - format0); + conversion = *format; + if (conversion == '%') + goto copy_char; discarded[format - format_start] = 1; format++; - while (strchr ("-+0# ", *format)) - { - if (*format == '-') - { - negative = 1; - } - discarded[format - format_start] = 1; - ++format; - } - - minlen = atoi (format); - - while ((*format >= '0' && *format <= '9') || *format == '.') - { - discarded[format - format_start] = 1; - format++; - } - - if (*format++ == '%') - { - *p++ = '%'; - nchars++; - continue; - } - ++n; - - discarded[format - format_start - 1] = 1; - info[n].start = nchars; - - if (STRINGP (args[n])) + if (! (n < nargs)) + error ("Not enough arguments for format string"); + + /* For 'S', prin1 the argument, and then treat like 's'. + For 's', princ any argument that is not a string or + symbol. But don't do this conversion twice, which might + happen after retrying. */ + if ((conversion == 'S' + || (conversion == 's' + && ! STRINGP (args[n]) && ! SYMBOLP (args[n])))) + { + if (! info[n].converted_to_string) + { + Lisp_Object noescape = conversion == 'S' ? Qnil : Qt; + args[n] = Fprin1_to_string (args[n], noescape); + info[n].converted_to_string = 1; + if (STRING_MULTIBYTE (args[n]) && ! multibyte) + { + multibyte = 1; + goto retry; + } + } + conversion = 's'; + } + else if (conversion == 'c') + { + if (FLOATP (args[n])) + { + double d = XFLOAT_DATA (args[n]); + args[n] = make_number (FIXNUM_OVERFLOW_P (d) ? -1 : d); + } + + if (INTEGERP (args[n]) && ! ASCII_CHAR_P (XINT (args[n]))) + { + if (!multibyte) + { + multibyte = 1; + goto retry; + } + args[n] = Fchar_to_string (args[n]); + info[n].converted_to_string = 1; + } + + if (info[n].converted_to_string) + conversion = 's'; + zero_flag = 0; + } + + if (SYMBOLP (args[n])) + { + args[n] = SYMBOL_NAME (args[n]); + if (STRING_MULTIBYTE (args[n]) && ! multibyte) + { + multibyte = 1; + goto retry; + } + } + + if (conversion == 's') { /* handle case (precision[n] >= 0) */ - int width, padding; - EMACS_INT nbytes, start; + EMACS_INT width, padding, nbytes; EMACS_INT nchars_string; + EMACS_INT prec = -1; + if (precision_given && precision <= TYPE_MAXIMUM (EMACS_INT)) + prec = precision; + /* lisp_string_width ignores a precision of 0, but GNU libc functions print 0 characters when the precision is 0. Imitate libc behavior here. Changing lisp_string_width is the right thing, and will be done, but meanwhile we work with it. */ - if (precision[n] == 0) + if (prec == 0) width = nchars_string = nbytes = 0; - else if (precision[n] > 0) - width = lisp_string_width (args[n], precision[n], - &nchars_string, &nbytes); - else - { /* no precision spec given for this argument */ - width = lisp_string_width (args[n], -1, NULL, NULL); - nbytes = SBYTES (args[n]); - nchars_string = SCHARS (args[n]); - } - - /* If spec requires it, pad on right with spaces. */ - padding = minlen - width; - if (! negative) - while (padding-- > 0) - { - *p++ = ' '; - ++nchars; - } - - info[n].start = start = nchars; - nchars += nchars_string; - - if (p > buf - && multibyte - && !ASCII_BYTE_P (*((unsigned char *) p - 1)) - && STRING_MULTIBYTE (args[n]) - && !CHAR_HEAD_P (SREF (args[n], 0))) - maybe_combine_byte = 1; - - p += copy_text (SDATA (args[n]), (unsigned char *) p, - nbytes, - STRING_MULTIBYTE (args[n]), multibyte); - - info[n].end = nchars; - - if (negative) - while (padding-- > 0) - { - *p++ = ' '; - nchars++; - } - - /* If this argument has text properties, record where - in the result string it appears. */ - if (STRING_INTERVALS (args[n])) - info[n].intervals = arg_intervals = 1; - } - else if (INTEGERP (args[n]) || FLOATP (args[n])) - { - int this_nchars; - - memcpy (this_format, this_format_start, - format - this_format_start); - this_format[format - this_format_start] = 0; - - if (format[-1] == 'e' || format[-1] == 'f' || format[-1] == 'g') - sprintf (p, this_format, XFLOAT_DATA (args[n])); - else - { - if (sizeof (EMACS_INT) > sizeof (int) - && format[-1] != 'c') - { - /* Insert 'l' before format spec. */ - this_format[format - this_format_start] - = this_format[format - this_format_start - 1]; - this_format[format - this_format_start - 1] = 'l'; - this_format[format - this_format_start + 1] = 0; - } - - if (INTEGERP (args[n])) - { - if (format[-1] == 'c') - sprintf (p, this_format, (int) XINT (args[n])); - else if (format[-1] == 'd') - sprintf (p, this_format, XINT (args[n])); - /* Don't sign-extend for octal or hex printing. */ - else - sprintf (p, this_format, XUINT (args[n])); - } - else if (format[-1] == 'c') - sprintf (p, this_format, (int) XFLOAT_DATA (args[n])); - else if (format[-1] == 'd') - /* Maybe we should use "%1.0f" instead so it also works - for values larger than MAXINT. */ - sprintf (p, this_format, (EMACS_INT) XFLOAT_DATA (args[n])); - else - /* Don't sign-extend for octal or hex printing. */ - sprintf (p, this_format, (EMACS_UINT) XFLOAT_DATA (args[n])); - } - - if (p > buf - && multibyte - && !ASCII_BYTE_P (*((unsigned char *) p - 1)) - && !CHAR_HEAD_P (*((unsigned char *) p))) - maybe_combine_byte = 1; - this_nchars = strlen (p); - if (multibyte) - p += str_to_multibyte ((unsigned char *) p, - buf + total - 1 - p, this_nchars); - else - p += this_nchars; - nchars += this_nchars; - info[n].end = nchars; - } - - } - else if (STRING_MULTIBYTE (args[0])) - { - /* Copy a whole multibyte character. */ - if (p > buf - && multibyte - && !ASCII_BYTE_P (*((unsigned char *) p - 1)) - && !CHAR_HEAD_P (*format)) - maybe_combine_byte = 1; - *p++ = *format++; - while (! CHAR_HEAD_P (*format)) - { - discarded[format - format_start] = 2; - *p++ = *format++; - } - nchars++; - } - else if (multibyte) - { - /* Convert a single-byte character to multibyte. */ - int len = copy_text ((unsigned char *) format, (unsigned char *) p, - 1, 0, 1); - - p += len; - format++; - nchars++; + else + { + EMACS_INT nch, nby; + width = lisp_string_width (args[n], prec, &nch, &nby); + if (prec < 0) + { + nchars_string = SCHARS (args[n]); + nbytes = SBYTES (args[n]); + } + else + { + nchars_string = nch; + nbytes = nby; + } + } + + convbytes = nbytes; + if (convbytes && multibyte && ! STRING_MULTIBYTE (args[n])) + convbytes = count_size_as_multibyte (SDATA (args[n]), nbytes); + + padding = width < field_width ? field_width - width : 0; + + if (max_bufsize - padding <= convbytes) + string_overflow (); + convbytes += padding; + if (convbytes <= buf + bufsize - p) + { + if (! minus_flag) + { + memset (p, ' ', padding); + p += padding; + nchars += padding; + } + + if (p > buf + && multibyte + && !ASCII_BYTE_P (*((unsigned char *) p - 1)) + && STRING_MULTIBYTE (args[n]) + && !CHAR_HEAD_P (SREF (args[n], 0))) + maybe_combine_byte = 1; + + p += copy_text (SDATA (args[n]), (unsigned char *) p, + nbytes, + STRING_MULTIBYTE (args[n]), multibyte); + + info[n].start = nchars; + nchars += nchars_string; + info[n].end = nchars; + + if (minus_flag) + { + memset (p, ' ', padding); + p += padding; + nchars += padding; + } + + /* If this argument has text properties, record where + in the result string it appears. */ + if (STRING_INTERVALS (args[n])) + info[n].intervals = arg_intervals = 1; + + continue; + } + } + else if (! (conversion == 'c' || conversion == 'd' + || conversion == 'e' || conversion == 'f' + || conversion == 'g' || conversion == 'i' + || conversion == 'o' || conversion == 'x' + || conversion == 'X')) + error ("Invalid format operation %%%c", + STRING_CHAR ((unsigned char *) format - 1)); + else if (! (INTEGERP (args[n]) || FLOATP (args[n]))) + error ("Format specifier doesn't match argument type"); + else + { + enum + { + /* Maximum precision for a %f conversion such that the + trailing output digit might be nonzero. Any precisions + larger than this will not yield useful information. */ + USEFUL_PRECISION_MAX = + ((1 - DBL_MIN_EXP) + * (FLT_RADIX == 2 || FLT_RADIX == 10 ? 1 + : FLT_RADIX == 16 ? 4 + : -1)), + + /* Maximum number of bytes generated by any format, if + precision is no more than DBL_USEFUL_PRECISION_MAX. + On all practical hosts, %f is the worst case. */ + SPRINTF_BUFSIZE = + sizeof "-." + (DBL_MAX_10_EXP + 1) + USEFUL_PRECISION_MAX + }; + verify (0 < USEFUL_PRECISION_MAX); + + int prec; + EMACS_INT padding, sprintf_bytes; + uintmax_t excess_precision, numwidth; + uintmax_t leading_zeros = 0, trailing_zeros = 0; + + char sprintf_buf[SPRINTF_BUFSIZE]; + + /* Copy of conversion specification, modified somewhat. + At most three flags F can be specified at once. */ + char convspec[sizeof "%FFF.*d" + pWIDElen]; + + /* Avoid undefined behavior in underlying sprintf. */ + if (conversion == 'd' || conversion == 'i') + sharp_flag = 0; + + /* Create the copy of the conversion specification, with + any width and precision removed, with ".*" inserted, + and with pWIDE inserted for integer formats. */ + { + char *f = convspec; + *f++ = '%'; + *f = '-'; f += minus_flag; + *f = '+'; f += plus_flag; + *f = ' '; f += space_flag; + *f = '#'; f += sharp_flag; + *f = '0'; f += zero_flag; + *f++ = '.'; + *f++ = '*'; + if (conversion == 'd' || conversion == 'i' + || conversion == 'o' || conversion == 'x' + || conversion == 'X') + { + memcpy (f, pWIDE, pWIDElen); + f += pWIDElen; + zero_flag &= ~ precision_given; + } + *f++ = conversion; + *f = '\0'; + } + + prec = -1; + if (precision_given) + prec = min (precision, USEFUL_PRECISION_MAX); + + /* Use sprintf to format this number into sprintf_buf. Omit + padding and excess precision, though, because sprintf limits + output length to INT_MAX. + + There are four types of conversion: double, unsigned + char (passed as int), wide signed int, and wide + unsigned int. Treat them separately because the + sprintf ABI is sensitive to which type is passed. Be + careful about integer overflow, NaNs, infinities, and + conversions; for example, the min and max macros are + not suitable here. */ + if (conversion == 'e' || conversion == 'f' || conversion == 'g') + { + double x = (INTEGERP (args[n]) + ? XINT (args[n]) + : XFLOAT_DATA (args[n])); + sprintf_bytes = sprintf (sprintf_buf, convspec, prec, x); + } + else if (conversion == 'c') + { + /* Don't use sprintf here, as it might mishandle prec. */ + sprintf_buf[0] = XINT (args[n]); + sprintf_bytes = prec != 0; + } + else if (conversion == 'd') + { + /* For float, maybe we should use "%1.0f" + instead so it also works for values outside + the integer range. */ + signed_wide x; + if (INTEGERP (args[n])) + x = XINT (args[n]); + else + { + double d = XFLOAT_DATA (args[n]); + if (d < 0) + { + x = TYPE_MINIMUM (signed_wide); + if (x < d) + x = d; + } + else + { + x = TYPE_MAXIMUM (signed_wide); + if (d < x) + x = d; + } + } + sprintf_bytes = sprintf (sprintf_buf, convspec, prec, x); + } + else + { + /* Don't sign-extend for octal or hex printing. */ + unsigned_wide x; + if (INTEGERP (args[n])) + x = XUINT (args[n]); + else + { + double d = XFLOAT_DATA (args[n]); + if (d < 0) + x = 0; + else + { + x = TYPE_MAXIMUM (unsigned_wide); + if (d < x) + x = d; + } + } + sprintf_bytes = sprintf (sprintf_buf, convspec, prec, x); + } + + /* Now the length of the formatted item is known, except it omits + padding and excess precision. Deal with excess precision + first. This happens only when the format specifies + ridiculously large precision. */ + excess_precision = precision - prec; + if (excess_precision) + { + if (conversion == 'e' || conversion == 'f' + || conversion == 'g') + { + if ((conversion == 'g' && ! sharp_flag) + || ! ('0' <= sprintf_buf[sprintf_bytes - 1] + && sprintf_buf[sprintf_bytes - 1] <= '9')) + excess_precision = 0; + else + { + if (conversion == 'g') + { + char *dot = strchr (sprintf_buf, '.'); + if (!dot) + excess_precision = 0; + } + } + trailing_zeros = excess_precision; + } + else + leading_zeros = excess_precision; + } + + /* Compute the total bytes needed for this item, including + excess precision and padding. */ + numwidth = sprintf_bytes + excess_precision; + padding = numwidth < field_width ? field_width - numwidth : 0; + if (max_bufsize - sprintf_bytes <= excess_precision + || max_bufsize - padding <= numwidth) + string_overflow (); + convbytes = numwidth + padding; + + if (convbytes <= buf + bufsize - p) + { + /* Copy the formatted item from sprintf_buf into buf, + inserting padding and excess-precision zeros. */ + + char *src = sprintf_buf; + char src0 = src[0]; + int exponent_bytes = 0; + int signedp = src0 == '-' || src0 == '+' || src0 == ' '; + int significand_bytes; + if (zero_flag && '0' <= src[signedp] && src[signedp] <= '9') + { + leading_zeros += padding; + padding = 0; + } + + if (excess_precision + && (conversion == 'e' || conversion == 'g')) + { + char *e = strchr (src, 'e'); + if (e) + exponent_bytes = src + sprintf_bytes - e; + } + + if (! minus_flag) + { + memset (p, ' ', padding); + p += padding; + nchars += padding; + } + + *p = src0; + src += signedp; + p += signedp; + memset (p, '0', leading_zeros); + p += leading_zeros; + significand_bytes = sprintf_bytes - signedp - exponent_bytes; + memcpy (p, src, significand_bytes); + p += significand_bytes; + src += significand_bytes; + memset (p, '0', trailing_zeros); + p += trailing_zeros; + memcpy (p, src, exponent_bytes); + p += exponent_bytes; + + info[n].start = nchars; + nchars += leading_zeros + sprintf_bytes + trailing_zeros; + info[n].end = nchars; + + if (minus_flag) + { + memset (p, ' ', padding); + p += padding; + nchars += padding; + } + + continue; + } + } } else - *p++ = *format++, nchars++; + copy_char: + { + /* Copy a single character from format to buf. */ + + char *src = format; + unsigned char str[MAX_MULTIBYTE_LENGTH]; + + if (multibyte_format) + { + /* Copy a whole multibyte character. */ + if (p > buf + && !ASCII_BYTE_P (*((unsigned char *) p - 1)) + && !CHAR_HEAD_P (*format)) + maybe_combine_byte = 1; + + do + format++; + while (! CHAR_HEAD_P (*format)); + + convbytes = format - format0; + memset (&discarded[format0 + 1 - format_start], 2, convbytes - 1); + } + else + { + unsigned char uc = *format++; + if (! multibyte || ASCII_BYTE_P (uc)) + convbytes = 1; + else + { + int c = BYTE8_TO_CHAR (uc); + convbytes = CHAR_STRING (c, str); + src = (char *) str; + } + } + + if (convbytes <= buf + bufsize - p) + { + memcpy (p, src, convbytes); + p += convbytes; + nchars++; + continue; + } + } + + /* There wasn't enough room to store this conversion or single + character. CONVBYTES says how much room is needed. Allocate + enough room (and then some) and do it again. */ + { + EMACS_INT used = p - buf; + + if (max_bufsize - used < convbytes) + string_overflow (); + bufsize = used + convbytes; + bufsize = bufsize < max_bufsize / 2 ? bufsize * 2 : max_bufsize; + + if (buf == initial_buffer) + { + buf = xmalloc (bufsize); + sa_must_free = 1; + buf_save_value = make_save_value (buf, 0); + record_unwind_protect (safe_alloca_unwind, buf_save_value); + memcpy (buf, initial_buffer, used); + } + else + XSAVE_VALUE (buf_save_value)->pointer = buf = xrealloc (buf, bufsize); + + p = buf + used; + } + + format = format0; + n = n0; } - if (p > buf + total) + if (bufsize < p - buf) abort (); if (maybe_combine_byte) @@ -4089,7 +4234,7 @@ if (CONSP (props)) { EMACS_INT bytepos = 0, position = 0, translated = 0; - int argn = 1; + EMACS_INT argn = 1; Lisp_Object list; /* Adjust the bounds of each text property === modified file 'src/fns.c' --- src/fns.c 2011-05-27 19:30:12 +0000 +++ src/fns.c 2011-05-27 19:37:32 +0000 @@ -898,7 +898,7 @@ if (STRING_MULTIBYTE (string)) return string; - nbytes = parse_str_to_multibyte (SDATA (string), SBYTES (string)); + nbytes = count_size_as_multibyte (SDATA (string), SBYTES (string)); /* If all the chars are ASCII, they won't need any more bytes once converted. */ if (nbytes == SBYTES (string)) === modified file 'src/insdel.c' --- src/insdel.c 2011-05-16 05:15:51 +0000 +++ src/insdel.c 2011-05-21 04:33:23 +0000 @@ -570,37 +570,6 @@ return to_addr - initial_to_addr; } } - -/* Return the number of bytes it would take - to convert some single-byte text to multibyte. - The single-byte text consists of NBYTES bytes at PTR. */ - -EMACS_INT -count_size_as_multibyte (const unsigned char *ptr, EMACS_INT nbytes) -{ - EMACS_INT i; - EMACS_INT outgoing_nbytes = 0; - - for (i = 0; i < nbytes; i++) - { - unsigned int c = *ptr++; - int n; - - if (ASCII_CHAR_P (c)) - n = 1; - else - { - c = BYTE8_TO_CHAR (c); - n = CHAR_BYTES (c); - } - - if (INT_ADD_OVERFLOW (outgoing_nbytes, n)) - string_overflow (); - outgoing_nbytes += n; - } - - return outgoing_nbytes; -} /* Insert a string of specified length before point. This function judges multibyteness based on === modified file 'src/lisp.h' --- src/lisp.h 2011-05-16 01:11:54 +0000 +++ src/lisp.h 2011-05-22 07:12:24 +0000 @@ -544,11 +544,10 @@ /* Value is non-zero if I doesn't fit into a Lisp fixnum. It is written this way so that it also works if I is of unsigned - type. */ + type or if I is a NaN. */ #define FIXNUM_OVERFLOW_P(i) \ - ((i) > MOST_POSITIVE_FIXNUM \ - || ((i) < 0 && (i) < MOST_NEGATIVE_FIXNUM)) + (! ((0 <= (i) || MOST_NEGATIVE_FIXNUM <= (i)) && (i) <= MOST_POSITIVE_FIXNUM)) /* Extract a value or address from a Lisp_Object. */ @@ -2574,7 +2573,6 @@ extern void make_gap (EMACS_INT); extern EMACS_INT copy_text (const unsigned char *, unsigned char *, EMACS_INT, int, int); -extern EMACS_INT count_size_as_multibyte (const unsigned char *, EMACS_INT); extern int count_combining_before (const unsigned char *, EMACS_INT, EMACS_INT, EMACS_INT); extern int count_combining_after (const unsigned char *, === modified file 'src/mem-limits.h' --- src/mem-limits.h 2011-01-25 04:08:28 +0000 +++ src/mem-limits.h 2011-05-23 00:22:43 +0000 @@ -40,8 +40,7 @@ #define EXCEEDS_LISP_PTR(ptr) 0 #elif defined DATA_SEG_BITS #define EXCEEDS_LISP_PTR(ptr) \ - (((EMACS_UINT) (ptr) & ~DATA_SEG_BITS) >> VALBITS) + (((uintptr_t) (ptr) & ~DATA_SEG_BITS) >> VALBITS) #else -#define EXCEEDS_LISP_PTR(ptr) ((EMACS_UINT) (ptr) >> VALBITS) +#define EXCEEDS_LISP_PTR(ptr) ((uintptr_t) (ptr) >> VALBITS) #endif - === modified file 'src/print.c' --- src/print.c 2011-05-12 07:07:06 +0000 +++ src/print.c 2011-05-21 04:33:23 +0000 @@ -381,7 +381,7 @@ EMACS_INT bytes; chars = SBYTES (string); - bytes = parse_str_to_multibyte (SDATA (string), chars); + bytes = count_size_as_multibyte (SDATA (string), chars); if (chars < bytes) { newstr = make_uninit_multibyte_string (chars, bytes); ------------------------------------------------------------ revno: 104389 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2011-05-27 16:39:18 -0300 message: * src/xselect.c (x_convert_selection): Yet another int/Lisp_Object mixup. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-05-27 19:32:01 +0000 +++ src/ChangeLog 2011-05-27 19:39:18 +0000 @@ -1,3 +1,7 @@ +2011-05-27 Stefan Monnier + + * xselect.c (x_convert_selection): Yet another int/Lisp_Object mixup. + 2011-05-27 Paul Eggert * xselect.c: Fix minor problems prompted by GCC 4.6.0 warnings. === modified file 'src/xselect.c' --- src/xselect.c 2011-05-27 19:32:01 +0000 +++ src/xselect.c 2011-05-27 19:39:18 +0000 @@ -904,7 +904,8 @@ converted_selections = cs; } - RETURN_UNGCPRO (0); + UNGCPRO; + return 0; } /* Otherwise, record the converted selection to binary. */ @@ -919,7 +920,8 @@ &(cs->data), &(cs->type), &(cs->size), &(cs->format), &(cs->nofree)); - RETURN_UNGCPRO (1); + UNGCPRO; + return 1; } /* Handle a SelectionClear event EVENT, which indicates that some ------------------------------------------------------------ revno: 104388 fixes bug(s): http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8745 author: David Michael committer: Stefan Monnier branch nick: trunk timestamp: Fri 2011-05-27 16:33:48 -0300 message: * lisp/files.el (interpreter-mode-alist): Add rbash. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-27 16:17:59 +0000 +++ lisp/ChangeLog 2011-05-27 19:33:48 +0000 @@ -1,3 +1,7 @@ +2011-05-27 David Michael + + * files.el (interpreter-mode-alist): Add rbash (bug#8745). + 2011-05-27 Chong Yidong * select.el: Support clipboard managers with built-in function === modified file 'lisp/files.el' --- lisp/files.el 2011-05-27 01:00:53 +0000 +++ lisp/files.el 2011-05-27 19:33:48 +0000 @@ -2523,6 +2523,7 @@ ("ksh" . sh-mode) ("oash" . sh-mode) ("pdksh" . sh-mode) + ("rbash" . sh-mode) ("rc" . sh-mode) ("rpm" . sh-mode) ("sh" . sh-mode) ------------------------------------------------------------ revno: 104387 [merge] committer: Paul Eggert branch nick: trunk timestamp: Fri 2011-05-27 12:32:43 -0700 message: Merge: Fix minor problems prompted by GCC 4.6.0 warnings. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-05-27 16:17:59 +0000 +++ src/ChangeLog 2011-05-27 19:32:01 +0000 @@ -1,3 +1,14 @@ +2011-05-27 Paul Eggert + + * xselect.c: Fix minor problems prompted by GCC 4.6.0 warnings. + (x_handle_selection_request, frame_for_x_selection): Remove unused vars. + (x_clipboard_manager_save): Now static. + (Fx_clipboard_manager_save): Rename local to avoid shadowing. + + * fns.c: Fix minor problems prompted by GCC 4.6.0 warnings. + (crypto_hash_function): Now static. + Fix pointer signedness problems. Avoid unnecessary initializations. + 2011-05-27 Chong Yidong * termhooks.h (Vselection_alist): Make it terminal-local. === modified file 'src/fns.c' --- src/fns.c 2011-05-24 08:22:58 +0000 +++ src/fns.c 2011-05-27 19:30:12 +0000 @@ -4522,7 +4522,7 @@ /* TYPE: 0 for md5, 1 for sha1. */ -Lisp_Object +static Lisp_Object crypto_hash_function (int type, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror, Lisp_Object binary) { int i; @@ -4708,17 +4708,16 @@ { case 0: /* MD5 */ { - unsigned char digest[16]; + char digest[16]; md5_buffer (SSDATA (object) + start_byte, SBYTES (object) - (size_byte - end_byte), digest); - if (NILP(binary)) + if (NILP (binary)) { - unsigned char value[33]; + char value[33]; for (i = 0; i < 16; i++) sprintf (&value[2 * i], "%02x", digest[i]); - value[32] = '\0'; res = make_string (value, 32); } else @@ -4728,16 +4727,15 @@ case 1: /* SHA1 */ { - unsigned char digest[20]; - sha1_buffer (SDATA (object) + start_byte, + char digest[20]; + sha1_buffer (SSDATA (object) + start_byte, SBYTES (object) - (size_byte - end_byte), digest); - if (NILP(binary)) + if (NILP (binary)) { - unsigned char value[41]; + char value[41]; for (i = 0; i < 20; i++) sprintf (&value[2 * i], "%02x", digest[i]); - value[40] = '\0'; res = make_string (value, 40); } else === modified file 'src/xselect.c' --- src/xselect.c 2011-05-27 16:17:59 +0000 +++ src/xselect.c 2011-05-27 19:32:01 +0000 @@ -822,7 +822,6 @@ /* Perform conversions. This can signal. */ for (j = 0; j < nselections; j++) { - struct selection_data *cs = converted_selections + j; Lisp_Object subtarget = AREF (multprop, 2*j); Atom subproperty = symbol_to_x_atom (dpyinfo, AREF (multprop, 2*j+1)); @@ -1878,7 +1877,7 @@ static struct frame * frame_for_x_selection (Lisp_Object object) { - Lisp_Object tail, frame; + Lisp_Object tail; struct frame *f; if (NILP (object)) @@ -2110,7 +2109,7 @@ UTF8_STRING property, as described by http://www.freedesktop.org/wiki/ClipboardManager */ -void +static void x_clipboard_manager_save (struct x_display_info *dpyinfo, Lisp_Object frame) { @@ -2157,7 +2156,7 @@ { /* Loop through all X displays, saving owned clipboards. */ struct x_display_info *dpyinfo; - Lisp_Object local_selection, frame; + Lisp_Object local_selection, local_frame; for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next) { local_selection = LOCAL_SELECTION (QCLIPBOARD, dpyinfo); @@ -2166,9 +2165,9 @@ dpyinfo->Xatom_CLIPBOARD_MANAGER)) continue; - frame = XCAR (XCDR (XCDR (XCDR (local_selection)))); - if (FRAME_LIVE_P (XFRAME (frame))) - x_clipboard_manager_save (dpyinfo, frame); + local_frame = XCAR (XCDR (XCDR (XCDR (local_selection)))); + if (FRAME_LIVE_P (XFRAME (local_frame))) + x_clipboard_manager_save (dpyinfo, local_frame); } } ------------------------------------------------------------ revno: 104386 committer: Paul Eggert branch nick: trunk timestamp: Fri 2011-05-27 09:58:43 -0700 message: * doc/misc/texinfo.tex, lib/getopt.c, lib/intprops.h: Merge from gnulib. diff: === modified file 'ChangeLog' --- ChangeLog 2011-05-24 20:09:08 +0000 +++ ChangeLog 2011-05-27 16:58:43 +0000 @@ -1,3 +1,7 @@ +2011-05-27 Paul Eggert + + * doc/misc/texinfo.tex, lib/getopt.c, lib/intprops.h: Merge from gnulib. + 2011-05-24 Glenn Morris * Makefile.in (check): Just give a message if no test/ directory. === modified file 'doc/misc/texinfo.tex' --- doc/misc/texinfo.tex 2011-05-18 00:39:40 +0000 +++ doc/misc/texinfo.tex 2011-05-27 16:58:43 +0000 @@ -3,7 +3,7 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2011-05-11.16} +\def\texinfoversion{2011-05-23.16} % % Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, % 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, @@ -693,15 +693,6 @@ \newdimen\mil \mil=0.001in -% Old definition--didn't work. -%\parseargdef\need{\par % -%% This method tries to make TeX break the page naturally -%% if the depth of the box does not fit. -%{\baselineskip=0pt% -%\vtop to #1\mil{\vfil}\kern -#1\mil\nobreak -%\prevdepth=-1000pt -%}} - \parseargdef\need{% % Ensure vertical mode, so we don't make a big box in the middle of a % paragraph. @@ -3227,7 +3218,7 @@ \finishedtitlepagetrue } -%%% Macros to be used within @titlepage: +% Macros to be used within @titlepage: \let\subtitlerm=\tenrm \def\subtitlefont{\subtitlerm \normalbaselineskip = 13pt \normalbaselines} @@ -3260,7 +3251,7 @@ } -%%% Set up page headings and footings. +% Set up page headings and footings. \let\thispage=\folio @@ -3959,9 +3950,9 @@ \setbox0=\vbox{X}\global\multitablelinespace=\the\baselineskip \global\advance\multitablelinespace by-\ht0 \fi -%% Test to see if parskip is larger than space between lines of -%% table. If not, do nothing. -%% If so, set to same dimension as multitablelinespace. +% Test to see if parskip is larger than space between lines of +% table. If not, do nothing. +% If so, set to same dimension as multitablelinespace. \ifdim\multitableparskip>\multitablelinespace \global\multitableparskip=\multitablelinespace \global\advance\multitableparskip-7pt %% to keep parskip somewhat smaller @@ -5536,14 +5527,13 @@ % (including whitespace, linebreaking, etc. around it), % given all the information in convenient, parsed form. -%%% Args are the skip and penalty (usually negative) +% Args are the skip and penalty (usually negative) \def\dobreak#1#2{\par\ifdim\lastskip<#1\removelastskip\penalty#2\vskip#1\fi} -%%% Define plain chapter starts, and page on/off switching for it % Parameter controlling skip before chapter headings (if needed) - \newskip\chapheadingskip +% Define plain chapter starts, and page on/off switching for it. \def\chapbreak{\dobreak \chapheadingskip {-4000}} \def\chappager{\par\vfill\supereject} % Because \domark is called before \chapoddpage, the filler page will @@ -6702,7 +6692,7 @@ % commands also insert a nobreak penalty, and we don't want to allow % a break between a section heading and a defun. % - % As a minor refinement, we avoid "club" headers by signalling + % As a further refinement, we avoid "club" headers by signalling % with penalty of 10003 after the very first @deffn in the % sequence (see above), and penalty of 10002 after any following % @def command. @@ -6769,13 +6759,36 @@ \def\domakedefun#1#2#3{% \envdef#1{% \startdefun + \doingtypefnfalse % distinguish typed functions from all else \parseargusing\activeparens{\printdefunline#3}% }% \def#2{\dodefunx#1}% \def#3% } -%%% Untyped functions: +\newif\ifdoingtypefn % doing typed function? +\newif\ifrettypeownline % typeset return type on its own line? + +% @deftypefnnewline on|off says whether the return type of typed functions +% are printed on their own line. This affects @deftypefn, @deftypefun, +% @deftypeop, and @deftypemethod. +% +\parseargdef\deftypefnnewline{% + \def\temp{#1}% + \ifx\temp\onword + \expandafter\let\csname SETtxideftypefnnl\endcsname + = \empty + \else\ifx\temp\offword + \expandafter\let\csname SETtxideftypefnnl\endcsname + = \relax + \else + \errhelp = \EMsimple + \errmessage{Unknown @txideftypefnnl value `\temp', + must be on|off}% + \fi\fi +} + +% Untyped functions: % @deffn category name args \makedefun{deffn}{\deffngeneral{}} @@ -6794,7 +6807,7 @@ \defname{#2}{}{#3}\magicamp\defunargs{#4\unskip}% } -%%% Typed functions: +% Typed functions: % @deftypefn category type name args \makedefun{deftypefn}{\deftypefngeneral{}} @@ -6809,10 +6822,11 @@ % \def\deftypefngeneral#1#2 #3 #4 #5\endheader{% \dosubind{fn}{\code{#4}}{#1}% + \doingtypefntrue \defname{#2}{#3}{#4}\defunargs{#5\unskip}% } -%%% Typed variables: +% Typed variables: % @deftypevr category type var args \makedefun{deftypevr}{\deftypecvgeneral{}} @@ -6830,7 +6844,7 @@ \defname{#2}{#3}{#4}\defunargs{#5\unskip}% } -%%% Untyped variables: +% Untyped variables: % @defvr category var args \makedefun{defvr}#1 {\deftypevrheader{#1} {} } @@ -6841,7 +6855,8 @@ % \defcvof {category of}class var args \def\defcvof#1#2 {\deftypecvof{#1}#2 {} } -%%% Type: +% Types: + % @deftp category name args \makedefun{deftp}#1 #2 #3\endheader{% \doind{tp}{\code{#2}}% @@ -6869,25 +6884,49 @@ % We are followed by (but not passed) the arguments, if any. % \def\defname#1#2#3{% + \par % Get the values of \leftskip and \rightskip as they were outside the @def... \advance\leftskip by -\defbodyindent % - % How we'll format the type name. Putting it in brackets helps + % Determine if we are typesetting the return type of a typed function + % on a line by itself. + \rettypeownlinefalse + \ifdoingtypefn % doing a typed function specifically? + % then check user option for putting return type on its own line: + \expandafter\ifx\csname SETtxideftypefnnl\endcsname\relax \else + \rettypeownlinetrue + \fi + \fi + % + % How we'll format the category name. Putting it in brackets helps % distinguish it from the body text that may end up on the next line % just below it. \def\temp{#1}% \setbox0=\hbox{\kern\deflastargmargin \ifx\temp\empty\else [\rm\temp]\fi} % - % Figure out line sizes for the paragraph shape. + % Figure out line sizes for the paragraph shape. We'll always have at + % least two. + \tempnum = 2 + % % The first line needs space for \box0; but if \rightskip is nonzero, % we need only space for the part of \box0 which exceeds it: \dimen0=\hsize \advance\dimen0 by -\wd0 \advance\dimen0 by \rightskip + % + % If doing a return type on its own line, we'll have another line. + \ifrettypeownline + \advance\tempnum by 1 + \def\maybeshapeline{0in \hsize}% + \else + \def\maybeshapeline{}% + \fi + % % The continuations: \dimen2=\hsize \advance\dimen2 by -\defargsindent - % (plain.tex says that \dimen1 should be used only as global.) - \parshape 2 0in \dimen0 \defargsindent \dimen2 - % - % Put the type name to the right margin. + % + % The final paragraph shape: + \parshape \tempnum 0in \dimen0 \maybeshapeline \defargsindent \dimen2 + % + % Put the category name at the right margin. \noindent \hbox to 0pt{% \hfil\box0 \kern-\hsize @@ -6909,8 +6948,16 @@ % . this still does not fix the ?` and !` ligatures, but so far no % one has made identifiers using them :). \df \tt - \def\temp{#2}% return value type - \ifx\temp\empty\else \tclose{\temp} \fi + \def\temp{#2}% text of the return type + \ifx\temp\empty\else + \tclose{\temp}% typeset the return type + \ifrettypeownline + % put return type on its own line; prohibit line break following: + \hfil\vadjust{\nobreak}\break + \else + \space % type on same line, so just followed by a space + \fi + \fi % no return type #3% output function name }% {\rm\enskip}% hskip 0.5 em of \tenrm === modified file 'lib/getopt.c' --- lib/getopt.c 2011-01-09 07:33:50 +0000 +++ lib/getopt.c 2011-05-27 16:58:43 +0000 @@ -479,8 +479,14 @@ || !strchr (optstring, argv[d->optind][1]))))) { char *nameend; + unsigned int namelen; const struct option *p; const struct option *pfound = NULL; + struct option_list + { + const struct option *p; + struct option_list *next; + } *ambig_list = NULL; int exact = 0; int ambig = 0; int indfound = -1; @@ -488,14 +494,14 @@ for (nameend = d->__nextchar; *nameend && *nameend != '='; nameend++) /* Do nothing. */ ; + namelen = nameend - d->__nextchar; /* Test all long options for either exact match or abbreviated matches. */ for (p = longopts, option_index = 0; p->name; p++, option_index++) - if (!strncmp (p->name, d->__nextchar, nameend - d->__nextchar)) + if (!strncmp (p->name, d->__nextchar, namelen)) { - if ((unsigned int) (nameend - d->__nextchar) - == (unsigned int) strlen (p->name)) + if (namelen == (unsigned int) strlen (p->name)) { /* Exact match found. */ pfound = p; @@ -513,35 +519,71 @@ || pfound->has_arg != p->has_arg || pfound->flag != p->flag || pfound->val != p->val) - /* Second or later nonexact match found. */ - ambig = 1; + { + /* Second or later nonexact match found. */ + struct option_list *newp = malloc (sizeof (*newp)); + newp->p = p; + newp->next = ambig_list; + ambig_list = newp; + } } - if (ambig && !exact) + if (ambig_list != NULL && !exact) { if (print_errors) { + struct option_list first; + first.p = pfound; + first.next = ambig_list; + ambig_list = &first; + #if defined _LIBC && defined USE_IN_LIBIO - char *buf; + char *buf = NULL; + size_t buflen = 0; - if (__asprintf (&buf, _("%s: option '%s' is ambiguous\n"), - argv[0], argv[d->optind]) >= 0) + FILE *fp = open_memstream (&buf, &buflen); + if (fp != NULL) { - _IO_flockfile (stderr); - - int old_flags2 = ((_IO_FILE *) stderr)->_flags2; - ((_IO_FILE *) stderr)->_flags2 |= _IO_FLAGS2_NOTCANCEL; - - __fxprintf (NULL, "%s", buf); - - ((_IO_FILE *) stderr)->_flags2 = old_flags2; - _IO_funlockfile (stderr); - - free (buf); + fprintf (fp, + _("%s: option '%s' is ambiguous; possibilities:"), + argv[0], argv[d->optind]); + + do + { + fprintf (fp, " '--%s'", ambig_list->p->name); + ambig_list = ambig_list->next; + } + while (ambig_list != NULL); + + fputc_unlocked ('\n', fp); + + if (__builtin_expect (fclose (fp) != EOF, 1)) + { + _IO_flockfile (stderr); + + int old_flags2 = ((_IO_FILE *) stderr)->_flags2; + ((_IO_FILE *) stderr)->_flags2 |= _IO_FLAGS2_NOTCANCEL; + + __fxprintf (NULL, "%s", buf); + + ((_IO_FILE *) stderr)->_flags2 = old_flags2; + _IO_funlockfile (stderr); + + free (buf); + } } #else - fprintf (stderr, _("%s: option '%s' is ambiguous\n"), + fprintf (stderr, + _("%s: option '%s' is ambiguous; possibilities:"), argv[0], argv[d->optind]); + do + { + fprintf (stderr, " '--%s'", ambig_list->p->name); + ambig_list = ambig_list->next; + } + while (ambig_list != NULL); + + fputc ('\n', stderr); #endif } d->__nextchar += strlen (d->__nextchar); @@ -550,6 +592,13 @@ return '?'; } + while (ambig_list != NULL) + { + struct option_list *pn = ambig_list->next; + free (ambig_list); + ambig_list = pn; + } + if (pfound != NULL) { option_index = indfound; === modified file 'lib/intprops.h' --- lib/intprops.h 2011-05-22 21:02:48 +0000 +++ lib/intprops.h 2011-05-27 16:58:43 +0000 @@ -25,11 +25,11 @@ /* Return a integer value, converted to the same type as the integer expression E after integer type promotion. V is the unconverted value. E should not have side effects. */ -#define _GL_INT_CONVERT(e, v) ((e) - (e) + (v)) +#define _GL_INT_CONVERT(e, v) (0 * (e) + (v)) /* Act like _GL_INT_CONVERT (E, -V) but work around a bug in IRIX 6.5 cc; see . */ -#define _GL_INT_NEGATE_CONVERT(e, v) ((e) - (e) - (v)) +#define _GL_INT_NEGATE_CONVERT(e, v) (0 * (e) - (v)) /* The extra casts in the following macros work around compiler bugs, e.g., in Cray C 5.0.3.0. */ @@ -314,7 +314,7 @@ Arguments should be free of side effects. */ #define _GL_BINARY_OP_OVERFLOW(a, b, op_result_overflow) \ op_result_overflow (a, b, \ - _GL_INT_MINIMUM ((b) - (b) + (a)), \ - _GL_INT_MAXIMUM ((b) - (b) + (a))) + _GL_INT_MINIMUM (0 * (b) + (a)), \ + _GL_INT_MAXIMUM (0 * (b) + (a))) #endif /* _GL_INTPROPS_H */ ------------------------------------------------------------ revno: 104385 committer: Chong Yidong branch nick: trunk timestamp: Fri 2011-05-27 12:17:59 -0400 message: Support X clipboard managers. * lisp/select.el (xselect-convert-to-targets): Add MULTIPLE target to list. (xselect-convert-to-save-targets): New function. * src/xselect.c: Support for clipboard managers. (Vselection_alist): Move to termhooks.h as terminal-local var. (LOCAL_SELECTION): New macro. (x_atom_to_symbol): Handle x_display_info_for_display fail case. (symbol_to_x_atom): Remove gratuitous arg. (x_handle_selection_request, lisp_data_to_selection_data) (x_get_foreign_selection, Fx_register_dnd_atom): Callers changed. (x_own_selection, x_get_local_selection, x_convert_selection): New arg, specifying work frame. Use terminal-local Vselection_alist. (some_frame_on_display): Delete unused function. (Fx_own_selection_internal, Fx_get_selection_internal) (Fx_disown_selection_internal, Fx_selection_owner_p) (Fx_selection_exists_p): New optional frame arg. (frame_for_x_selection, Fx_clipboard_manager_save): New functions. (x_handle_selection_clear): Don't treat other terminals with the same keyboard specially. Use the terminal-local Vselection_alist. (x_clear_frame_selections): Use Frun_hook_with_args. * src/termhooks.h (Vselection_alist): Make it terminal-local. * src/terminal.c (create_terminal): Initialize it. * src/xterm.c (x_term_init): Intern ATOM and CLIPBOARD_MANAGER atoms. * src/xterm.h: Add support for those atoms. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-27 07:18:15 +0000 +++ lisp/ChangeLog 2011-05-27 16:17:59 +0000 @@ -1,3 +1,11 @@ +2011-05-27 Chong Yidong + + * select.el: Support clipboard managers with built-in function + x-clipboard-manager-save, via delete-frame-functions and + kill-emacs-hook. + (xselect-convert-to-targets): Add MULTIPLE target to list. + (xselect-convert-to-save-targets): New function. + 2011-05-27 Kenichi Handa * mail/sendmail.el (mail-encode-header): Avoid double encoding by === modified file 'lisp/select.el' --- lisp/select.el 2011-04-19 13:44:55 +0000 +++ lisp/select.el 2011-05-27 16:17:59 +0000 @@ -289,7 +289,9 @@ (defun xselect-convert-to-targets (_selection _type _value) ;; return a vector of atoms, but remove duplicates first. - (let* ((all (cons 'TIMESTAMP (mapcar 'car selection-converter-alist))) + (let* ((all (cons 'TIMESTAMP + (cons 'MULTIPLE + (mapcar 'car selection-converter-alist)))) (rest all)) (while rest (cond ((memq (car rest) (cdr rest)) @@ -365,6 +367,12 @@ (defun xselect-convert-to-identity (_selection _type value) ; used internally (vector value)) +;; Null target that tells clipboard managers we support SAVE_TARGETS +;; (see freedesktop.org Clipboard Manager spec). +(defun xselect-convert-to-save-targets (selection _type _value) + (when (eq selection 'CLIPBOARD) + 'NULL)) + (setq selection-converter-alist '((TEXT . xselect-convert-to-string) (COMPOUND_TEXT . xselect-convert-to-string) @@ -384,8 +392,13 @@ (NAME . xselect-convert-to-name) (ATOM . xselect-convert-to-atom) (INTEGER . xselect-convert-to-integer) + (SAVE_TARGETS . xselect-convert-to-save-targets) (_EMACS_INTERNAL . xselect-convert-to-identity))) +(when (fboundp 'x-clipboard-manager-save) + (add-hook 'delete-frame-functions 'x-clipboard-manager-save) + (add-hook 'kill-emacs-hook 'x-clipboard-manager-save)) + (provide 'select) ;;; select.el ends here === modified file 'src/ChangeLog' --- src/ChangeLog 2011-05-26 17:42:32 +0000 +++ src/ChangeLog 2011-05-27 16:17:59 +0000 @@ -1,3 +1,31 @@ +2011-05-27 Chong Yidong + + * termhooks.h (Vselection_alist): Make it terminal-local. + + * terminal.c (create_terminal): Initialize it. + + * xselect.c: Support for clipboard managers. + (Vselection_alist): Move to termhooks.h as terminal-local var. + (LOCAL_SELECTION): New macro. + (x_atom_to_symbol): Handle x_display_info_for_display fail case. + (symbol_to_x_atom): Remove gratuitous arg. + (x_handle_selection_request, lisp_data_to_selection_data) + (x_get_foreign_selection, Fx_register_dnd_atom): Callers changed. + (x_own_selection, x_get_local_selection, x_convert_selection): New + arg, specifying work frame. Use terminal-local Vselection_alist. + (some_frame_on_display): Delete unused function. + (Fx_own_selection_internal, Fx_get_selection_internal) + (Fx_disown_selection_internal, Fx_selection_owner_p) + (Fx_selection_exists_p): New optional frame arg. + (frame_for_x_selection, Fx_clipboard_manager_save): New functions. + (x_handle_selection_clear): Don't treat other terminals with the + same keyboard specially. Use the terminal-local Vselection_alist. + (x_clear_frame_selections): Use Frun_hook_with_args. + + * xterm.c (x_term_init): Intern ATOM and CLIPBOARD_MANAGER atoms. + + * xterm.h: Add support for those atoms. + 2011-05-26 Chong Yidong * xselect.c: ICCCM-compliant handling of MULTIPLE targets. === modified file 'src/termhooks.h' --- src/termhooks.h 2011-05-15 17:17:44 +0000 +++ src/termhooks.h 2011-05-27 16:17:59 +0000 @@ -335,6 +335,22 @@ the member terminal_coding. */ Lisp_Object charset_list; + /* This is an association list containing the X selections that + Emacs might own on this terminal. Each element has the form + (SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME) + SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom. + SELECTION-VALUE is the value that emacs owns for that selection. + It may be any kind of Lisp object. + SELECTION-TIMESTAMP is the time at which emacs began owning this + selection, as a cons of two 16-bit numbers (making a 32 bit + time.) + FRAME is the frame for which we made the selection. If there is + an entry in this alist, then it can be assumed that Emacs owns + that selection. + The only (eq) parts of this list that are visible from Lisp are + the selection-values. */ + Lisp_Object Vselection_alist; + /* All fields before `next_terminal' should be Lisp_Object and are traced by the GC. All fields afterwards are ignored by the GC. */ === modified file 'src/terminal.c' --- src/terminal.c 2011-04-14 05:04:02 +0000 +++ src/terminal.c 2011-05-27 16:17:59 +0000 @@ -256,6 +256,8 @@ setup_coding_system (terminal_coding, terminal->terminal_coding); terminal->param_alist = Qnil; + terminal->charset_list = Qnil; + terminal->Vselection_alist = Qnil; return terminal; } === modified file 'src/xselect.c' --- src/xselect.c 2011-05-26 19:20:59 +0000 +++ src/xselect.c 2011-05-27 16:17:59 +0000 @@ -46,27 +46,25 @@ struct selection_data; static Lisp_Object x_atom_to_symbol (Display *dpy, Atom atom); -static Atom symbol_to_x_atom (struct x_display_info *, Display *, - Lisp_Object); -static void x_own_selection (Lisp_Object, Lisp_Object); -static Lisp_Object x_get_local_selection (Lisp_Object, Lisp_Object, int); +static Atom symbol_to_x_atom (struct x_display_info *, Lisp_Object); +static void x_own_selection (Lisp_Object, Lisp_Object, Lisp_Object); +static Lisp_Object x_get_local_selection (Lisp_Object, Lisp_Object, int, + struct x_display_info *); static void x_decline_selection_request (struct input_event *); static Lisp_Object x_selection_request_lisp_error (Lisp_Object); static Lisp_Object queue_selection_requests_unwind (Lisp_Object); -static Lisp_Object some_frame_on_display (struct x_display_info *); static Lisp_Object x_catch_errors_unwind (Lisp_Object); static void x_reply_selection_request (struct input_event *, struct x_display_info *); static int x_convert_selection (struct input_event *, Lisp_Object, Lisp_Object, - Atom, int); + Atom, int, struct x_display_info *); static int waiting_for_other_props_on_window (Display *, Window); static struct prop_location *expect_property_change (Display *, Window, Atom, int); static void unexpect_property_change (struct prop_location *); static Lisp_Object wait_for_property_change_unwind (Lisp_Object); static void wait_for_property_change (struct prop_location *); -static Lisp_Object x_get_foreign_selection (Lisp_Object, - Lisp_Object, - Lisp_Object); +static Lisp_Object x_get_foreign_selection (Lisp_Object, Lisp_Object, + Lisp_Object, Lisp_Object); static void x_get_window_property (Display *, Window, Atom, unsigned char **, int *, Atom *, int *, unsigned long *, int); @@ -105,7 +103,7 @@ static Lisp_Object QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP, QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL, - QATOM_PAIR; + QATOM_PAIR, QCLIPBOARD_MANAGER, QSAVE_TARGETS; static Lisp_Object QCOMPOUND_TEXT; /* This is a type of selection. */ static Lisp_Object QUTF8_STRING; /* This is a type of selection. */ @@ -124,20 +122,8 @@ #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100) -/* This is an association list whose elements are of the form - ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME) - SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom. - SELECTION-VALUE is the value that emacs owns for that selection. - It may be any kind of Lisp object. - SELECTION-TIMESTAMP is the time at which emacs began owning this selection, - as a cons of two 16-bit numbers (making a 32 bit time.) - FRAME is the frame for which we made the selection. - If there is an entry in this alist, then it can be assumed that Emacs owns - that selection. - The only (eq) parts of this list that are visible from Lisp are the - selection-values. */ -static Lisp_Object Vselection_alist; - +#define LOCAL_SELECTION(selection_symbol,dpyinfo) \ + assq_no_quit (selection_symbol, dpyinfo->terminal->Vselection_alist) /* Define a queue to save up SELECTION_REQUEST_EVENT events for later @@ -224,7 +210,7 @@ roundtrip whenever possible. */ static Atom -symbol_to_x_atom (struct x_display_info *dpyinfo, Display *display, Lisp_Object sym) +symbol_to_x_atom (struct x_display_info *dpyinfo, Lisp_Object sym) { Atom val; if (NILP (sym)) return 0; @@ -248,7 +234,7 @@ TRACE1 (" XInternAtom %s", SSDATA (SYMBOL_NAME (sym))); BLOCK_INPUT; - val = XInternAtom (display, SSDATA (SYMBOL_NAME (sym)), False); + val = XInternAtom (dpyinfo->display, SSDATA (SYMBOL_NAME (sym)), False); UNBLOCK_INPUT; return val; } @@ -282,6 +268,8 @@ } dpyinfo = x_display_info_for_display (dpy); + if (dpyinfo == NULL) + return Qnil; if (atom == dpyinfo->Xatom_CLIPBOARD) return QCLIPBOARD; if (atom == dpyinfo->Xatom_TIMESTAMP) @@ -319,28 +307,20 @@ } /* Do protocol to assert ourself as a selection owner. + FRAME shall be the owner; it must be a valid X frame. Update the Vselection_alist so that we can reply to later requests for our selection. */ static void -x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value) +x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value, + Lisp_Object frame) { - struct frame *sf = SELECTED_FRAME (); - Window selecting_window; - Display *display; + struct frame *f = XFRAME (frame); + Window selecting_window = FRAME_X_WINDOW (f); + struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + Display *display = dpyinfo->display; Time timestamp = last_event_timestamp; - Atom selection_atom; - struct x_display_info *dpyinfo; - - if (! FRAME_X_P (sf)) - return; - - selecting_window = FRAME_X_WINDOW (sf); - display = FRAME_X_DISPLAY (sf); - dpyinfo = FRAME_X_DISPLAY_INFO (sf); - - CHECK_SYMBOL (selection_name); - selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name); + Atom selection_atom = symbol_to_x_atom (dpyinfo, selection_name); BLOCK_INPUT; x_catch_errors (display); @@ -351,27 +331,26 @@ /* Now update the local cache */ { - Lisp_Object selection_time; Lisp_Object selection_data; Lisp_Object prev_value; - selection_time = long_to_cons (timestamp); selection_data = list4 (selection_name, selection_value, - selection_time, selected_frame); - prev_value = assq_no_quit (selection_name, Vselection_alist); - - Vselection_alist = Fcons (selection_data, Vselection_alist); - - /* If we already owned the selection, remove the old selection data. - Perhaps we should destructively modify it instead. - Don't use Fdelq as that may QUIT. */ + long_to_cons (timestamp), frame); + prev_value = LOCAL_SELECTION (selection_name, dpyinfo); + + dpyinfo->terminal->Vselection_alist + = Fcons (selection_data, dpyinfo->terminal->Vselection_alist); + + /* If we already owned the selection, remove the old selection + data. Don't use Fdelq as that may QUIT. */ if (!NILP (prev_value)) { - Lisp_Object rest; /* we know it's not the CAR, so it's easy. */ - for (rest = Vselection_alist; CONSP (rest); rest = XCDR (rest)) + /* We know it's not the CAR, so it's easy. */ + Lisp_Object rest = dpyinfo->terminal->Vselection_alist; + for (; CONSP (rest); rest = XCDR (rest)) if (EQ (prev_value, Fcar (XCDR (rest)))) { - XSETCDR (rest, Fcdr (XCDR (rest))); + XSETCDR (rest, XCDR (XCDR (rest))); break; } } @@ -387,17 +366,18 @@ This calls random Lisp code, and may signal or gc. */ static Lisp_Object -x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type, int local_request) +x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type, + int local_request, struct x_display_info *dpyinfo) { Lisp_Object local_value; Lisp_Object handler_fn, value, check; int count; - local_value = assq_no_quit (selection_symbol, Vselection_alist); + local_value = LOCAL_SELECTION (selection_symbol, dpyinfo); if (NILP (local_value)) return Qnil; - /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */ + /* TIMESTAMP is a special case. */ if (EQ (target_type, QTIMESTAMP)) { handler_fn = Qnil; @@ -585,23 +565,6 @@ return Qnil; } -/* Return some frame whose display info is DPYINFO. - Return nil if there is none. */ - -static Lisp_Object -some_frame_on_display (struct x_display_info *dpyinfo) -{ - Lisp_Object list, frame; - - FOR_EACH_FRAME (list, frame) - { - if (FRAME_X_P (XFRAME (frame)) - && FRAME_X_DISPLAY_INFO (XFRAME (frame)) == dpyinfo) - return frame; - } - - return Qnil; -} /* Send the reply to a selection request event EVENT. */ @@ -648,36 +611,36 @@ the conversion itself must be done in the same order. */ for (cs = converted_selections; cs; cs = cs->next) { - if (cs->property != None) - { - bytes_remaining = cs->size * (cs->format / 8); - if (bytes_remaining <= max_bytes) - { - /* Send all the data at once, with minimal handshaking. */ - TRACE1 ("Sending all %d bytes", bytes_remaining); - XChangeProperty (display, window, cs->property, - cs->type, cs->format, PropModeReplace, - cs->data, cs->size); - } - else - { - /* Send an INCR tag to initiate incremental transfer. */ - long value[1]; - - TRACE2 ("Start sending %d bytes incrementally (%s)", - bytes_remaining, XGetAtomName (display, cs->property)); - cs->wait_object - = expect_property_change (display, window, cs->property, - PropertyDelete); - - /* XChangeProperty expects an array of long even if long - is more than 32 bits. */ - value[0] = bytes_remaining; - XChangeProperty (display, window, cs->property, - dpyinfo->Xatom_INCR, 32, PropModeReplace, - (unsigned char *) value, 1); - XSelectInput (display, window, PropertyChangeMask); - } + if (cs->property == None) + continue; + + bytes_remaining = cs->size * (cs->format / 8); + if (bytes_remaining <= max_bytes) + { + /* Send all the data at once, with minimal handshaking. */ + TRACE1 ("Sending all %d bytes", bytes_remaining); + XChangeProperty (display, window, cs->property, + cs->type, cs->format, PropModeReplace, + cs->data, cs->size); + } + else + { + /* Send an INCR tag to initiate incremental transfer. */ + long value[1]; + + TRACE2 ("Start sending %d bytes incrementally (%s)", + bytes_remaining, XGetAtomName (display, cs->property)); + cs->wait_object + = expect_property_change (display, window, cs->property, + PropertyDelete); + + /* XChangeProperty expects an array of long even if long is + more than 32 bits. */ + value[0] = bytes_remaining; + XChangeProperty (display, window, cs->property, + dpyinfo->Xatom_INCR, 32, PropModeReplace, + (unsigned char *) value, 1); + XSelectInput (display, window, PropertyChangeMask); } } @@ -740,7 +703,8 @@ cs->type, cs->format, PropModeAppend, cs->data, i); bytes_remaining -= i * format_bytes; - cs->data += i * ((cs->format == 32) ? sizeof (long) : format_bytes); + cs->data += i * ((cs->format == 32) ? sizeof (long) + : format_bytes); XFlush (display); had_errors = x_had_errors_p (display); UNBLOCK_INPUT; @@ -800,19 +764,20 @@ Display *display = SELECTION_EVENT_DISPLAY (event); struct x_display_info *dpyinfo = x_display_info_for_display (display); - Atom selection = SELECTION_EVENT_SELECTION (event); Lisp_Object selection_symbol = x_atom_to_symbol (display, selection); Atom target = SELECTION_EVENT_TARGET (event); Lisp_Object target_symbol = x_atom_to_symbol (display, target); Atom property = SELECTION_EVENT_PROPERTY (event); - Lisp_Object local_selection_data - = assq_no_quit (selection_symbol, Vselection_alist); + Lisp_Object local_selection_data; int success = 0; int count = SPECPDL_INDEX (); - GCPRO2 (local_selection_data, target_symbol); + if (!dpyinfo) goto DONE; + + local_selection_data = LOCAL_SELECTION (selection_symbol, dpyinfo); + /* Decline if we don't own any selections. */ if (NILP (local_selection_data)) goto DONE; @@ -846,8 +811,9 @@ int j, nselections; if (property == None) goto DONE; - multprop = x_get_window_property_as_lisp_data (display, requestor, property, - QMULTIPLE, selection); + multprop + = x_get_window_property_as_lisp_data (display, requestor, property, + QMULTIPLE, selection); if (!VECTORP (multprop) || ASIZE (multprop) % 2) goto DONE; @@ -858,12 +824,12 @@ { struct selection_data *cs = converted_selections + j; Lisp_Object subtarget = AREF (multprop, 2*j); - Atom subproperty = symbol_to_x_atom (dpyinfo, display, + Atom subproperty = symbol_to_x_atom (dpyinfo, AREF (multprop, 2*j+1)); if (subproperty != None) x_convert_selection (event, selection_symbol, subtarget, - subproperty, 1); + subproperty, 1, dpyinfo); } success = 1; } @@ -872,7 +838,8 @@ if (property == None) property = SELECTION_EVENT_TARGET (event); success = x_convert_selection (event, selection_symbol, - target_symbol, property, 0); + target_symbol, property, + 0, dpyinfo); } DONE: @@ -907,10 +874,9 @@ Return 0 if the selection failed to convert, 1 otherwise. */ static int -x_convert_selection (struct input_event *event, - Lisp_Object selection_symbol, - Lisp_Object target_symbol, - Atom property, int for_multiple) +x_convert_selection (struct input_event *event, Lisp_Object selection_symbol, + Lisp_Object target_symbol, Atom property, + int for_multiple, struct x_display_info *dpyinfo) { struct gcpro gcpro1; Lisp_Object lisp_selection; @@ -918,7 +884,8 @@ GCPRO1 (lisp_selection); lisp_selection - = x_get_local_selection (selection_symbol, target_symbol, 0); + = x_get_local_selection (selection_symbol, target_symbol, + 0, dpyinfo); /* A nil return value means we can't perform the conversion. */ if (NILP (lisp_selection) @@ -970,32 +937,14 @@ Lisp_Object selection_symbol, local_selection_data; Time local_selection_time; struct x_display_info *dpyinfo = x_display_info_for_display (display); - struct x_display_info *t_dpyinfo; + Lisp_Object Vselection_alist; TRACE0 ("x_handle_selection_clear"); - /* If the new selection owner is also Emacs, - don't clear the new selection. */ - BLOCK_INPUT; - /* Check each display on the same terminal, - to see if this Emacs job now owns the selection - through that display. */ - for (t_dpyinfo = x_display_list; t_dpyinfo; t_dpyinfo = t_dpyinfo->next) - if (t_dpyinfo->terminal->kboard == dpyinfo->terminal->kboard) - { - Window owner_window - = XGetSelectionOwner (t_dpyinfo->display, selection); - if (x_window_to_frame (t_dpyinfo, owner_window) != 0) - { - UNBLOCK_INPUT; - return; - } - } - UNBLOCK_INPUT; + if (!dpyinfo) return; selection_symbol = x_atom_to_symbol (display, selection); - - local_selection_data = assq_no_quit (selection_symbol, Vselection_alist); + local_selection_data = LOCAL_SELECTION (selection_symbol, dpyinfo); /* Well, we already believe that we don't own it, so that's just fine. */ if (NILP (local_selection_data)) return; @@ -1003,43 +952,38 @@ local_selection_time = (Time) cons_to_long (XCAR (XCDR (XCDR (local_selection_data)))); - /* This SelectionClear is for a selection that we no longer own, so we can - disregard it. (That is, we have reasserted the selection since this - request was generated.) */ - + /* We have reasserted the selection since this SelectionClear was + generated, so we can disregard it. */ if (changed_owner_time != CurrentTime && local_selection_time > changed_owner_time) return; - /* Otherwise, we're really honest and truly being told to drop it. - Don't use Fdelq as that may QUIT;. */ - - if (EQ (local_selection_data, Fcar (Vselection_alist))) - Vselection_alist = Fcdr (Vselection_alist); + /* Otherwise, really clear. Don't use Fdelq as that may QUIT;. */ + Vselection_alist = dpyinfo->terminal->Vselection_alist; + if (EQ (local_selection_data, CAR (Vselection_alist))) + Vselection_alist = XCDR (Vselection_alist); else { Lisp_Object rest; for (rest = Vselection_alist; CONSP (rest); rest = XCDR (rest)) - if (EQ (local_selection_data, Fcar (XCDR (rest)))) + if (EQ (local_selection_data, CAR (XCDR (rest)))) { - XSETCDR (rest, Fcdr (XCDR (rest))); + XSETCDR (rest, XCDR (XCDR (rest))); break; } } - - /* Let random lisp code notice that the selection has been stolen. */ - + dpyinfo->terminal->Vselection_alist = Vselection_alist; + + /* Run the `x-lost-selection-functions' abnormal hook. */ { - Lisp_Object rest; - rest = Vx_lost_selection_functions; - if (!EQ (rest, Qunbound)) - { - for (; CONSP (rest); rest = Fcdr (rest)) - call1 (Fcar (rest), selection_symbol); - prepare_menu_bars (); - redisplay_preserve_echo_area (20); - } + Lisp_Object args[2]; + args[0] = Vx_lost_selection_functions; + args[1] = selection_symbol; + Frun_hook_with_args (2, args); } + + prepare_menu_bars (); + redisplay_preserve_echo_area (20); } void @@ -1063,55 +1007,34 @@ { Lisp_Object frame; Lisp_Object rest; + struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + struct terminal *t = dpyinfo->terminal; XSETFRAME (frame, f); - /* Otherwise, we're really honest and truly being told to drop it. - Don't use Fdelq as that may QUIT;. */ - /* Delete elements from the beginning of Vselection_alist. */ - while (!NILP (Vselection_alist) - && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist))))))) + while (CONSP (t->Vselection_alist) + && EQ (frame, XCAR (XCDR (XCDR (XCDR (XCAR (t->Vselection_alist))))))) { - /* Let random Lisp code notice that the selection has been stolen. */ - Lisp_Object hooks, selection_symbol; - - hooks = Vx_lost_selection_functions; - selection_symbol = Fcar (Fcar (Vselection_alist)); - - if (!EQ (hooks, Qunbound)) - { - for (; CONSP (hooks); hooks = Fcdr (hooks)) - call1 (Fcar (hooks), selection_symbol); -#if 0 /* This can crash when deleting a frame - from x_connection_closed. Anyway, it seems unnecessary; - something else should cause a redisplay. */ - redisplay_preserve_echo_area (21); -#endif - } - - Vselection_alist = Fcdr (Vselection_alist); + /* Run the `x-lost-selection-functions' abnormal hook. */ + Lisp_Object args[2]; + args[0] = Vx_lost_selection_functions; + args[1] = Fcar (Fcar (t->Vselection_alist)); + Frun_hook_with_args (2, args); + + t->Vselection_alist = XCDR (t->Vselection_alist); } /* Delete elements after the beginning of Vselection_alist. */ - for (rest = Vselection_alist; CONSP (rest); rest = XCDR (rest)) - if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest)))))))) + for (rest = t->Vselection_alist; CONSP (rest); rest = XCDR (rest)) + if (CONSP (XCDR (rest)) + && EQ (frame, XCAR (XCDR (XCDR (XCDR (XCAR (XCDR (rest)))))))) { - /* Let random Lisp code notice that the selection has been stolen. */ - Lisp_Object hooks, selection_symbol; - - hooks = Vx_lost_selection_functions; - selection_symbol = Fcar (Fcar (XCDR (rest))); - - if (!EQ (hooks, Qunbound)) - { - for (; CONSP (hooks); hooks = Fcdr (hooks)) - call1 (Fcar (hooks), selection_symbol); -#if 0 /* See above */ - redisplay_preserve_echo_area (22); -#endif - } - XSETCDR (rest, Fcdr (XCDR (rest))); + Lisp_Object args[2]; + args[0] = Vx_lost_selection_functions; + args[1] = XCAR (XCAR (XCDR (rest))); + Frun_hook_with_args (2, args); + XSETCDR (rest, XCDR (XCDR (rest))); break; } } @@ -1265,37 +1188,29 @@ static Window reading_selection_window; /* Do protocol to read selection-data from the server. - Converts this to Lisp data and returns it. */ + Converts this to Lisp data and returns it. + FRAME is the frame whose X window shall request the selection. */ static Lisp_Object -x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type, Lisp_Object time_stamp) +x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type, + Lisp_Object time_stamp, Lisp_Object frame) { - struct frame *sf = SELECTED_FRAME (); - Window requestor_window; - Display *display; - struct x_display_info *dpyinfo; + struct frame *f = XFRAME (frame); + struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + Display *display = dpyinfo->display; + Window requestor_window = FRAME_X_WINDOW (f); Time requestor_time = last_event_timestamp; - Atom target_property; - Atom selection_atom; - Atom type_atom; + Atom target_property = dpyinfo->Xatom_EMACS_TMP; + Atom selection_atom = symbol_to_x_atom (dpyinfo, selection_symbol); + Atom type_atom = (CONSP (target_type) + ? symbol_to_x_atom (dpyinfo, XCAR (target_type)) + : symbol_to_x_atom (dpyinfo, target_type)); int secs, usecs; int count = SPECPDL_INDEX (); - Lisp_Object frame; - if (! FRAME_X_P (sf)) + if (!FRAME_LIVE_P (f)) return Qnil; - requestor_window = FRAME_X_WINDOW (sf); - display = FRAME_X_DISPLAY (sf); - dpyinfo = FRAME_X_DISPLAY_INFO (sf); - target_property = dpyinfo->Xatom_EMACS_TMP; - selection_atom = symbol_to_x_atom (dpyinfo, display, selection_symbol); - - if (CONSP (target_type)) - type_atom = symbol_to_x_atom (dpyinfo, display, XCAR (target_type)); - else - type_atom = symbol_to_x_atom (dpyinfo, display, target_type); - if (! NILP (time_stamp)) { if (CONSP (time_stamp)) @@ -1329,18 +1244,13 @@ reading_which_selection = selection_atom; XSETCAR (reading_selection_reply, Qnil); - frame = some_frame_on_display (dpyinfo); - /* It should not be necessary to stop handling selection requests during this time. In fact, the SAVE_TARGETS mechanism requires us to handle a clipboard manager's requests before it returns SelectionNotify. */ #if 0 - if (!NILP (frame)) - { - x_start_queuing_selection_requests (); - record_unwind_protect (queue_selection_requests_unwind, Qnil); - } + x_start_queuing_selection_requests (); + record_unwind_protect (queue_selection_requests_unwind, Qnil); #endif UNBLOCK_INPUT; @@ -1820,7 +1730,7 @@ *size_ret = 1; *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1); (*data_ret) [sizeof (Atom)] = 0; - (*(Atom **) data_ret) [0] = symbol_to_x_atom (dpyinfo, display, obj); + (*(Atom **) data_ret) [0] = symbol_to_x_atom (dpyinfo, obj); if (NILP (type)) type = QATOM; } else if (INTEGERP (obj) @@ -1868,7 +1778,7 @@ *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom)); for (i = 0; i < *size_ret; i++) (*(Atom **) data_ret) [i] - = symbol_to_x_atom (dpyinfo, display, XVECTOR (obj)->contents [i]); + = symbol_to_x_atom (dpyinfo, XVECTOR (obj)->contents [i]); } else /* This vector is an INTEGER set, or something like it */ @@ -1902,7 +1812,7 @@ else signal_error (/* Qselection_error */ "Unrecognized selection data", obj); - *type_ret = symbol_to_x_atom (dpyinfo, display, type); + *type_ret = symbol_to_x_atom (dpyinfo, type); } static Lisp_Object @@ -1959,19 +1869,74 @@ } +/* From a Lisp_Object, return a suitable frame for selection + operations. OBJECT may be a frame, a terminal object, or nil + (which stands for the selected frame--or, if that is not an X + frame, the first X display on the list). If no suitable frame can + be found, return NULL. */ + +static struct frame * +frame_for_x_selection (Lisp_Object object) +{ + Lisp_Object tail, frame; + struct frame *f; + + if (NILP (object)) + { + f = XFRAME (selected_frame); + if (FRAME_X_P (f) && FRAME_LIVE_P (f)) + return f; + + for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail)) + { + f = XFRAME (XCAR (tail)); + if (FRAME_X_P (f) && FRAME_LIVE_P (f)) + return f; + } + } + else if (TERMINALP (object)) + { + struct terminal *t = get_terminal (object, 1); + if (t->type == output_x_window) + { + for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail)) + { + f = XFRAME (XCAR (tail)); + if (FRAME_LIVE_P (f) && f->terminal == t) + return f; + } + } + } + else if (FRAMEP (object)) + { + f = XFRAME (object); + if (FRAME_X_P (f) && FRAME_LIVE_P (f)) + return f; + } + + return NULL; +} + + DEFUN ("x-own-selection-internal", Fx_own_selection_internal, - Sx_own_selection_internal, 2, 2, 0, + Sx_own_selection_internal, 2, 3, 0, doc: /* Assert an X selection of type SELECTION and value VALUE. SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. \(Those are literal upper-case symbol names, since that's what X expects.) VALUE is typically a string, or a cons of two markers, but may be -anything that the functions on `selection-converter-alist' know about. */) - (Lisp_Object selection, Lisp_Object value) +anything that the functions on `selection-converter-alist' know about. + +FRAME should be a frame that should own the selection. If omitted or +nil, it defaults to the selected frame. */) + (Lisp_Object selection, Lisp_Object value, Lisp_Object frame) { - check_x (); + if (NILP (frame)) frame = selected_frame; + if (!FRAME_LIVE_P (XFRAME (frame)) || !FRAME_X_P (XFRAME (frame))) + error ("X selection unavailable for this frame"); + CHECK_SYMBOL (selection); if (NILP (value)) error ("VALUE may not be nil"); - x_own_selection (selection, value); + x_own_selection (selection, value, frame); return value; } @@ -1981,38 +1946,42 @@ will block until all of the data has arrived. */ DEFUN ("x-get-selection-internal", Fx_get_selection_internal, - Sx_get_selection_internal, 2, 3, 0, + Sx_get_selection_internal, 2, 4, 0, doc: /* Return text selected from some X window. SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. \(Those are literal upper-case symbol names, since that's what X expects.) TYPE is the type of data desired, typically `STRING'. TIME_STAMP is the time to use in the XConvertSelection call for foreign -selections. If omitted, defaults to the time for the last event. */) - (Lisp_Object selection_symbol, Lisp_Object target_type, Lisp_Object time_stamp) +selections. If omitted, defaults to the time for the last event. + +TERMINAL should be a terminal object or a frame specifying the X +server to query. If omitted or nil, that stands for the selected +frame's display, or the first available X display. */) + (Lisp_Object selection_symbol, Lisp_Object target_type, + Lisp_Object time_stamp, Lisp_Object terminal) { Lisp_Object val = Qnil; struct gcpro gcpro1, gcpro2; + struct frame *f = frame_for_x_selection (terminal); GCPRO2 (target_type, val); /* we store newly consed data into these */ - check_x (); + CHECK_SYMBOL (selection_symbol); - -#if 0 /* #### MULTIPLE doesn't work yet */ - if (CONSP (target_type) - && XCAR (target_type) == QMULTIPLE) + CHECK_SYMBOL (target_type); + if (EQ (target_type, QMULTIPLE)) + error ("Retrieving MULTIPLE selections is currently unimplemented"); + if (!f) + error ("X selection unavailable for this frame"); + + val = x_get_local_selection (selection_symbol, target_type, 1, + FRAME_X_DISPLAY_INFO (f)); + + if (NILP (val) && FRAME_LIVE_P (f)) { - CHECK_VECTOR (XCDR (target_type)); - /* So we don't destructively modify this... */ - target_type = copy_multiple_data (target_type); + Lisp_Object frame; + XSETFRAME (frame, f); + RETURN_UNGCPRO (x_get_foreign_selection (selection_symbol, target_type, + time_stamp, frame)); } - else -#endif - CHECK_SYMBOL (target_type); - - val = x_get_local_selection (selection_symbol, target_type, 1); - - if (NILP (val)) - RETURN_UNGCPRO (x_get_foreign_selection (selection_symbol, - target_type, time_stamp)); if (CONSP (val) && SYMBOLP (XCAR (val))) { @@ -2024,10 +1993,14 @@ } DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal, - Sx_disown_selection_internal, 1, 2, 0, + Sx_disown_selection_internal, 1, 3, 0, doc: /* If we own the selection SELECTION, disown it. -Disowning it means there is no such selection. */) - (Lisp_Object selection, Lisp_Object time_object) +Disowning it means there is no such selection. + +TERMINAL should be a terminal object or a frame specifying the X +server to query. If omitted or nil, that stands for the selected +frame's display, or the first available X display. */) + (Lisp_Object selection, Lisp_Object time_object, Lisp_Object terminal) { Time timestamp; Atom selection_atom; @@ -2035,29 +2008,25 @@ struct selection_input_event sie; struct input_event ie; } event; - Display *display; + struct frame *f = frame_for_x_selection (terminal); struct x_display_info *dpyinfo; - struct frame *sf = SELECTED_FRAME (); - check_x (); - if (! FRAME_X_P (sf)) + if (!f) return Qnil; - display = FRAME_X_DISPLAY (sf); - dpyinfo = FRAME_X_DISPLAY_INFO (sf); + dpyinfo = FRAME_X_DISPLAY_INFO (f); CHECK_SYMBOL (selection); - if (NILP (time_object)) - timestamp = last_event_timestamp; - else - timestamp = cons_to_long (time_object); - - if (NILP (assq_no_quit (selection, Vselection_alist))) - return Qnil; /* Don't disown the selection when we're not the owner. */ - - selection_atom = symbol_to_x_atom (dpyinfo, display, selection); + + /* Don't disown the selection when we're not the owner. */ + if (NILP (LOCAL_SELECTION (selection, dpyinfo))) + return Qnil; + + selection_atom = symbol_to_x_atom (dpyinfo, selection); BLOCK_INPUT; - XSetSelectionOwner (display, selection_atom, None, timestamp); + timestamp = (NILP (time_object) ? last_event_timestamp + : cons_to_long (time_object)); + XSetSelectionOwner (dpyinfo->display, selection_atom, None, timestamp); UNBLOCK_INPUT; /* It doesn't seem to be guaranteed that a SelectionClear event will be @@ -2065,7 +2034,7 @@ the selection owner to None. The NCD server does, the MIT Sun4 server doesn't. So we synthesize one; this means we might get two, but that's ok, because the second one won't have any effect. */ - SELECTION_EVENT_DISPLAY (&event.sie) = display; + SELECTION_EVENT_DISPLAY (&event.sie) = dpyinfo->display; SELECTION_EVENT_SELECTION (&event.sie) = selection_atom; SELECTION_EVENT_TIME (&event.sie) = timestamp; x_handle_selection_clear (&event.ie); @@ -2074,59 +2043,138 @@ } DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p, - 0, 1, 0, + 0, 2, 0, doc: /* Whether the current Emacs process owns the given X Selection. The arg should be the name of the selection in question, typically one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. \(Those are literal upper-case symbol names, since that's what X expects.) For convenience, the symbol nil is the same as `PRIMARY', -and t is the same as `SECONDARY'. */) - (Lisp_Object selection) +and t is the same as `SECONDARY'. + +TERMINAL should be a terminal object or a frame specifying the X +server to query. If omitted or nil, that stands for the selected +frame's display, or the first available X display. */) + (Lisp_Object selection, Lisp_Object terminal) { - check_x (); + struct frame *f = frame_for_x_selection (terminal); + CHECK_SYMBOL (selection); if (EQ (selection, Qnil)) selection = QPRIMARY; if (EQ (selection, Qt)) selection = QSECONDARY; - if (NILP (Fassq (selection, Vselection_alist))) + if (f && !NILP (LOCAL_SELECTION (selection, FRAME_X_DISPLAY_INFO (f)))) + return Qt; + else return Qnil; - return Qt; } DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p, - 0, 1, 0, - doc: /* Whether there is an owner for the given X Selection. -The arg should be the name of the selection in question, typically one of -the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. -\(Those are literal upper-case symbol names, since that's what X expects.) -For convenience, the symbol nil is the same as `PRIMARY', -and t is the same as `SECONDARY'. */) - (Lisp_Object selection) + 0, 2, 0, + doc: /* Whether there is an owner for the given X selection. +SELECTION should be the name of the selection in question, typically +one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. (X expects +these literal upper-case names.) The symbol nil is the same as +`PRIMARY', and t is the same as `SECONDARY'. + +TERMINAL should be a terminal object or a frame specifying the X +server to query. If omitted or nil, that stands for the selected +frame's display, or the first available X display. */) + (Lisp_Object selection, Lisp_Object terminal) { Window owner; Atom atom; - Display *dpy; - struct frame *sf = SELECTED_FRAME (); - - /* It should be safe to call this before we have an X frame. */ - if (! FRAME_X_P (sf)) - return Qnil; - - dpy = FRAME_X_DISPLAY (sf); + struct frame *f = frame_for_x_selection (terminal); + struct x_display_info *dpyinfo; + CHECK_SYMBOL (selection); - if (!NILP (Fx_selection_owner_p (selection))) - return Qt; if (EQ (selection, Qnil)) selection = QPRIMARY; if (EQ (selection, Qt)) selection = QSECONDARY; - atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf), dpy, selection); - if (atom == 0) + + if (!f) return Qnil; + + dpyinfo = FRAME_X_DISPLAY_INFO (f); + + if (!NILP (LOCAL_SELECTION (selection, dpyinfo))) + return Qt; + + atom = symbol_to_x_atom (dpyinfo, selection); + if (atom == 0) return Qnil; BLOCK_INPUT; - owner = XGetSelectionOwner (dpy, atom); + owner = XGetSelectionOwner (dpyinfo->display, atom); UNBLOCK_INPUT; return (owner ? Qt : Qnil); } +/* Send the clipboard manager a SAVE_TARGETS request with a + UTF8_STRING property, as described by + http://www.freedesktop.org/wiki/ClipboardManager */ + +void +x_clipboard_manager_save (struct x_display_info *dpyinfo, + Lisp_Object frame) +{ + struct frame *f = XFRAME (frame); + Atom data = dpyinfo->Xatom_UTF8_STRING; + + XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + dpyinfo->Xatom_EMACS_TMP, + dpyinfo->Xatom_ATOM, 32, PropModeReplace, + (unsigned char *) &data, 1); + x_get_foreign_selection (QCLIPBOARD_MANAGER, QSAVE_TARGETS, + Qnil, frame); +} + +DEFUN ("x-clipboard-manager-save", Fx_clipboard_manager_save, + Sx_clipboard_manager_save, 0, 1, 0, + doc: /* Save the clipboard contents to the clipboard manager. +This function is intended to run from `delete-frame-functions' and +`kill-emacs-hook', to transfer clipboard data owned by Emacs to a +clipboard manager prior to deleting a frame or killing Emacs. + +FRAME specifies a frame owning a clipboard; do nothing if FRAME does +not own the clipboard, or if no clipboard manager is present. If +FRAME is nil, save all clipboard contents owned by Emacs. */) + (Lisp_Object frame) +{ + if (FRAMEP (frame)) + { + struct frame *f = XFRAME (frame); + if (FRAME_LIVE_P (f) && FRAME_X_P (f)) + { + struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + Lisp_Object local_selection + = LOCAL_SELECTION (QCLIPBOARD, dpyinfo); + + if (!NILP (local_selection) + && EQ (frame, XCAR (XCDR (XCDR (XCDR (local_selection))))) + && XGetSelectionOwner (dpyinfo->display, + dpyinfo->Xatom_CLIPBOARD_MANAGER)) + x_clipboard_manager_save (dpyinfo, frame); + } + } + else if (NILP (frame)) + { + /* Loop through all X displays, saving owned clipboards. */ + struct x_display_info *dpyinfo; + Lisp_Object local_selection, frame; + for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next) + { + local_selection = LOCAL_SELECTION (QCLIPBOARD, dpyinfo); + if (NILP (local_selection) + || !XGetSelectionOwner (dpyinfo->display, + dpyinfo->Xatom_CLIPBOARD_MANAGER)) + continue; + + frame = XCAR (XCDR (XCDR (XCDR (local_selection)))); + if (FRAME_LIVE_P (XFRAME (frame))) + x_clipboard_manager_save (dpyinfo, frame); + } + } + + return Qnil; +} + /*********************************************************************** Drag and drop support @@ -2325,7 +2373,7 @@ if (SYMBOLP (atom)) - x_atom = symbol_to_x_atom (dpyinfo, FRAME_X_DISPLAY (f), atom); + x_atom = symbol_to_x_atom (dpyinfo, atom); else if (STRINGP (atom)) { BLOCK_INPUT; @@ -2537,6 +2585,7 @@ defsubr (&Sx_disown_selection_internal); defsubr (&Sx_selection_owner_p); defsubr (&Sx_selection_exists_p); + defsubr (&Sx_clipboard_manager_save); defsubr (&Sx_get_atom_name); defsubr (&Sx_send_client_message); @@ -2552,9 +2601,6 @@ property_change_reply = Fcons (Qnil, Qnil); staticpro (&property_change_reply); - Vselection_alist = Qnil; - staticpro (&Vselection_alist); - converted_selections = NULL; conversion_fail_tag = None; @@ -2618,6 +2664,8 @@ DEFSYM (QTARGETS, "TARGETS"); DEFSYM (QATOM, "ATOM"); DEFSYM (QATOM_PAIR, "ATOM_PAIR"); + DEFSYM (QCLIPBOARD_MANAGER, "CLIPBOARD_MANAGER"); + DEFSYM (QSAVE_TARGETS, "SAVE_TARGETS"); DEFSYM (QNULL, "NULL"); DEFSYM (Qcompound_text_with_extensions, "compound-text-with-extensions"); DEFSYM (Qforeign_selection, "foreign-selection"); === modified file 'src/xterm.c' --- src/xterm.c 2011-05-15 17:17:44 +0000 +++ src/xterm.c 2011-05-27 16:17:59 +0000 @@ -10186,7 +10186,9 @@ { "_EMACS_TMP_", &dpyinfo->Xatom_EMACS_TMP }, { "TARGETS", &dpyinfo->Xatom_TARGETS }, { "NULL", &dpyinfo->Xatom_NULL }, + { "ATOM", &dpyinfo->Xatom_ATOM }, { "ATOM_PAIR", &dpyinfo->Xatom_ATOM_PAIR }, + { "CLIPBOARD_MANAGER", &dpyinfo->Xatom_CLIPBOARD_MANAGER }, { "_XEMBED_INFO", &dpyinfo->Xatom_XEMBED_INFO }, /* For properties of font. */ { "PIXEL_SIZE", &dpyinfo->Xatom_PIXEL_SIZE }, === modified file 'src/xterm.h' --- src/xterm.h 2011-05-11 23:16:52 +0000 +++ src/xterm.h 2011-05-27 16:17:59 +0000 @@ -254,7 +254,7 @@ Atom Xatom_CLIPBOARD, Xatom_TIMESTAMP, Xatom_TEXT, Xatom_DELETE, Xatom_COMPOUND_TEXT, Xatom_UTF8_STRING, Xatom_MULTIPLE, Xatom_INCR, Xatom_EMACS_TMP, Xatom_TARGETS, Xatom_NULL, - Xatom_ATOM_PAIR; + Xatom_ATOM, Xatom_ATOM_PAIR, Xatom_CLIPBOARD_MANAGER; /* More atoms for font properties. The last three are private properties, see the comments in src/fontset.h. */ @@ -1027,7 +1027,7 @@ /* Defined in xfns.c */ -extern struct x_display_info * check_x_display_info (Lisp_Object frame); +extern struct x_display_info * check_x_display_info (Lisp_Object); extern Lisp_Object x_get_focus_frame (struct frame *); #ifdef USE_GTK ------------------------------------------------------------ revno: 104384 [merge] committer: Glenn Morris branch nick: trunk timestamp: Fri 2011-05-27 00:18:15 -0700 message: Merge from emacs-23; up to r100588. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-27 01:58:50 +0000 +++ lisp/ChangeLog 2011-05-27 07:18:15 +0000 @@ -1,3 +1,8 @@ +2011-05-27 Kenichi Handa + + * mail/sendmail.el (mail-encode-header): Avoid double encoding by + let-binding rfc2047-encode-encoded-words to nil. + 2011-05-27 Glenn Morris * mail/emacsbug.el: Don't require url-util. === modified file 'lisp/mail/sendmail.el' --- lisp/mail/sendmail.el 2011-05-24 03:54:18 +0000 +++ lisp/mail/sendmail.el 2011-05-27 07:18:15 +0000 @@ -1022,7 +1022,8 @@ (if (and selected (coding-system-get selected :mime-charset)) (cons selected mm-coding-system-priorities) mm-coding-system-priorities)) - (tick (buffer-chars-modified-tick))) + (tick (buffer-chars-modified-tick)) + (rfc2047-encode-encoded-words nil)) (rfc2047-encode-message-header) (= tick (buffer-chars-modified-tick))))) ------------------------------------------------------------ revno: 104383 committer: Glenn Morris branch nick: trunk timestamp: Thu 2011-05-26 21:58:50 -0400 message: * lisp/mail/emacsbug.el: Don't require url-util. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-27 01:54:56 +0000 +++ lisp/ChangeLog 2011-05-27 01:58:50 +0000 @@ -1,5 +1,7 @@ 2011-05-27 Glenn Morris + * mail/emacsbug.el: Don't require url-util. + * shell.el (shell-directory-tracker): Case matters. (Bug#8735) * files.el (set-auto-mode): === modified file 'lisp/mail/emacsbug.el' --- lisp/mail/emacsbug.el 2011-05-26 16:14:53 +0000 +++ lisp/mail/emacsbug.el 2011-05-27 01:58:50 +0000 @@ -32,8 +32,6 @@ ;;; Code: -(require 'url-util) - (defgroup emacsbug nil "Sending Emacs bug reports." :group 'maint ------------------------------------------------------------ Use --include-merges or -n0 to see merged revisions.