[COMMIT] Be better about searching for chars typed via XIM and x-compose.el, isearch
13 years, 1 month
Aidan Kehoe
Aidan Kehoe
Mats, you had a problem a few years ago where isearch within dired and Gnus
summary buffers wouldn’t accept ä and ö and so on. I’ve had some
half-finished work addressing that sitting on my hard disk since then, and
I finally got to it today. I’m confident that it works for me, but back then
my initial patches also worked for me but failed for you, so I’d be curious
as to whether this is still true.
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1299935491 0
# Node ID 6f10ac29bf40f8d2c13e66a3c4748232f86cac41
# Parent 4c4b96b13f70850c10a8ff4f8617b158b13971cd
Be better about searching for chars typed via XIM and x-compose.el, isearch
lisp/ChangeLog addition:
2011-03-12 Aidan Kehoe <kehoea(a)parhasard.net>
* isearch-mode.el (isearch-mode-map):
Document why we bind the ASCII characters to isearch-printing-char
in more detail.
* isearch-mode.el (isearch-maybe-frob-keyboard-macros):
If `this-command' is nil and the keys typed would normally be
bound to `self-insert-command' in the global map, force
`isearch-printing-char' to be called with an appropriate value for
last-command-event. Addresses an issue where searching for
characters generated from x-compose.el and XIM threw errors for me
in dired.
src/ChangeLog addition:
2011-03-12 Aidan Kehoe <kehoea(a)parhasard.net>
* event-stream.c (Fdispatch_event):
As documented, allow pre-command-hook to usefully modify
this-command even when this-command is nil (that is, we would
normally throw an undefined-keystroke-sequence error). Don't throw
that error if this-command was modified, instead try to execute
the new value.
Allow pre-command-hook to modify last-command-event in this
specific context. Don't document this, for the moment.
diff -r 4c4b96b13f70 -r 6f10ac29bf40 lisp/ChangeLog
--- a/lisp/ChangeLog Fri Mar 11 20:40:01 2011 +0000
+++ b/lisp/ChangeLog Sat Mar 12 13:11:31 2011 +0000
＠＠ -1,3 +1,16 ＠＠
+2011-03-12 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * isearch-mode.el (isearch-mode-map):
+ Document why we bind the ASCII characters to isearch-printing-char
+ in more detail.
+ * isearch-mode.el (isearch-maybe-frob-keyboard-macros):
+ If `this-command' is nil and the keys typed would normally be
+ bound to `self-insert-command' in the global map, force
+ `isearch-printing-char' to be called with an appropriate value for
+ last-command-event. Addresses an issue where searching for
+ characters generated from x-compose.el and XIM threw errors for me
+ in dired.
+
2011-03-10 Aidan Kehoe <kehoea(a)parhasard.net>
* etags.el (buffer-tag-table-list):
diff -r 4c4b96b13f70 -r 6f10ac29bf40 lisp/isearch-mode.el
--- a/lisp/isearch-mode.el Fri Mar 11 20:40:01 2011 +0000
+++ b/lisp/isearch-mode.el Sat Mar 12 13:11:31 2011 +0000
＠＠ -239,10 +239,18 ＠＠
(let ((map (make-keymap)))
(set-keymap-name map 'isearch-mode-map)
- ;; Bind all printing characters to `isearch-printing-char'.
- ;; This isn't normally necessary, but if a printing character were
- ;; bound to something other than self-insert-command in global-map,
- ;; then it would terminate the search and be executed without this.
+ ;; Bind ASCII printing characters to `isearch-printing-char'. This
+ ;; isn't normally necessary, but if a printing character were bound to
+ ;; something other than self-insert-command in global-map, then it would
+ ;; terminate the search and be executed without this.
+
+ ;; This is also relevant when other modes (notably dired and gnus) call
+ ;; `suppress-keymap' on their major mode maps; this means that
+ ;; `isearch-maybe-frob-keyboard-macros' won't pick up that the command
+ ;; that would normally be executed is `self-insert-command' and do its
+ ;; thing of transforming that to `isearch-printing-char'. This is less
+ ;; of an issue for the non-ASCII characters, because they rarely have
+ ;; specific bindings in major modes.
(let ((i 32)
(str (make-string 1 0)))
(while (< i 127)
＠＠ -1609,8 +1617,27 ＠＠
last-command-char (and (stringp this-command)
(aref this-command 0))
this-command 'isearch-printing-char))
- ))
-
+ ((and (null this-command)
+ (eq 'key-press (event-type last-command-event))
+ (current-local-map)
+ (let* ((this-command-keys (this-command-keys))
+ (this-command-keys (or (lookup-key function-key-map
+ this-command-keys)
+ this-command-keys))
+ (lookup-key (lookup-key global-map this-command-keys)))
+ (and (eq 'self-insert-command lookup-key)
+ ;; The feature here that a modification of
+ ;; last-command-event is respected is undocumented, and
+ ;; only applies when this-command is nil. The design
+ ;; isn't reat, and I welcome suggestions for a better
+ ;; one.
+ (setq last-command-event
+ (find-if 'key-press-event-p this-command-keys
+:from-end t)
+ last-command-char
+ (event-to-character last-command-event)
+ this-command 'isearch-printing-char)))))))
+
;;;========================================================
;;; Highlighting
diff -r 4c4b96b13f70 -r 6f10ac29bf40 src/ChangeLog
--- a/src/ChangeLog Fri Mar 11 20:40:01 2011 +0000
+++ b/src/ChangeLog Sat Mar 12 13:11:31 2011 +0000
＠＠ -1,3 +1,14 ＠＠
+2011-03-12 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * event-stream.c (Fdispatch_event):
+ As documented, allow pre-command-hook to usefully modify
+ this-command even when this-command is nil (that is, we would
+ normally throw an undefined-keystroke-sequence error). Don't throw
+ that error if this-command was modified, instead try to execute
+ the new value.
+ Allow pre-command-hook to modify last-command-event in this
+ specific context. Don't document this, for the moment.
+
2011-03-11 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecode.c (optimize_byte_code):
diff -r 4c4b96b13f70 -r 6f10ac29bf40 src/event-stream.c
--- a/src/event-stream.c Fri Mar 11 20:40:01 2011 +0000
+++ b/src/event-stream.c Sat Mar 12 13:11:31 2011 +0000
＠＠ -4445,6 +4445,7 ＠＠
{
Lisp_Object leaf = lookup_command_event (command_builder, event, 1);
+ lookedup:
if (KEYMAPP (leaf))
/* Incomplete key sequence */
break;
＠＠ -4524,6 +4525,22 ＠＠
GCPRO1 (keys);
pre_command_hook ();
UNGCPRO;
+
+ if (!NILP (Vthis_command))
+ {
+ /* Allow pre-command-hook to change the command to
+ something more useful, and avoid barfing. */
+ leaf = Vthis_command;
+ if (!EQ (command_builder->most_current_event,
+ Vlast_command_event))
+ {
+ reset_current_events (command_builder);
+ command_builder_append_event (command_builder,
+ Vlast_command_event);
+ }
+ goto lookedup;
+ }
+
/* The post-command-hook doesn't run. */
Fsignal (Qundefined_keystroke_sequence, list1 (keys));
}
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 1 comments
[COMMIT] Update png_instantiate () to work with more recent versions of libpng.
13 years, 1 month
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1300136685 0
# Node ID 6c3a695f54f56c4456368dd5f97242e66efa6311
# Parent 6f10ac29bf40f8d2c13e66a3c4748232f86cac41
Update png_instantiate () to work with more recent versions of libpng.
2011-03-14 Aidan Kehoe <kehoea(a)parhasard.net>
* glyphs-eimage.c (png_instantiate):
Update the PNG handling code to work with versions of the library
where the png_info structure is no longer visible. Thank you for
the report, Robert Delius Royar.
diff -r 6f10ac29bf40 -r 6c3a695f54f5 src/ChangeLog
--- a/src/ChangeLog Sat Mar 12 13:11:31 2011 +0000
+++ b/src/ChangeLog Mon Mar 14 21:04:45 2011 +0000
＠＠ -1,3 +1,10 ＠＠
+2011-03-14 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * glyphs-eimage.c (png_instantiate):
+ Update the PNG handling code to work with versions of the library
+ where the png_info structure is no longer visible. Thank you for
+ the report, Robert Delius Royar.
+
2011-03-12 Aidan Kehoe <kehoea(a)parhasard.net>
* event-stream.c (Fdispatch_event):
diff -r 6f10ac29bf40 -r 6c3a695f54f5 src/glyphs-eimage.c
--- a/src/glyphs-eimage.c Sat Mar 12 13:11:31 2011 +0000
+++ b/src/glyphs-eimage.c Mon Mar 14 21:04:45 2011 +0000
＠＠ -982,8 +982,8 ＠＠
int y, padding;
Binbyte **row_pointers;
UINT_64_BIT pixels_sq;
- height = info_ptr->height;
- width = info_ptr->width;
+ height = png_get_image_height (png_ptr, info_ptr);
+ width = png_get_image_width (png_ptr, info_ptr);
pixels_sq = (UINT_64_BIT) width * (UINT_64_BIT) height;
if (pixels_sq > ((size_t) -1) / 3)
signal_image_error ("PNG image too large to instantiate", instantiator);
＠＠ -1044,30 +1044,37 ＠＠
/* Now that we're using EImage, ask for 8bit RGB triples for any type
of image*/
- /* convert palette images to RGB */
- if (info_ptr->color_type == PNG_COLOR_TYPE_PALETTE)
- png_set_palette_to_rgb (png_ptr);
- /* convert grayscale images to RGB */
- else if (info_ptr->color_type == PNG_COLOR_TYPE_GRAY ||
- info_ptr->color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
- png_set_gray_to_rgb (png_ptr);
- /* pad images with depth < 8 bits */
- else if (info_ptr->bit_depth < 8)
+ switch (png_get_color_type (png_ptr, info_ptr))
{
- if (info_ptr->color_type == PNG_COLOR_TYPE_GRAY)
- png_set_expand (png_ptr);
- else
- png_set_packing (png_ptr);
+ case PNG_COLOR_TYPE_PALETTE:
+ /* convert palette images to RGB */
+ png_set_palette_to_rgb (png_ptr);
+ break;
+
+ case PNG_COLOR_TYPE_GRAY:
+ case PNG_COLOR_TYPE_GRAY_ALPHA:
+ /* convert grayscale images to RGB */
+ png_set_gray_to_rgb (png_ptr);
+ break;
+
+ default:
+ /* pad images with depth < 8 bits */
+ if (png_get_bit_depth (png_ptr, info_ptr) < 8)
+ {
+ png_set_packing (png_ptr);
+ }
+ break;
}
+
/* strip 16-bit depth files down to 8 bits */
- if (info_ptr->bit_depth == 16)
+ if (png_get_bit_depth (png_ptr, info_ptr) == 16)
png_set_strip_16 (png_ptr);
/* strip alpha channel
#### shouldn't we handle this?
first call png_read_update_info in case above transformations
have generated an alpha channel */
png_read_update_info(png_ptr, info_ptr);
- if (info_ptr->color_type & PNG_COLOR_MASK_ALPHA)
+ if (png_get_color_type (png_ptr, info_ptr) & PNG_COLOR_MASK_ALPHA)
png_set_strip_alpha (png_ptr);
png_read_image (png_ptr, row_pointers);
＠＠ -1077,23 +1084,25 ＠＠
* into the glyph code, where you can get to it from lisp
* anyway. - WMP */
{
- int i;
+ int ii, num_text = 0;
+ png_textp text_ptr = NULL;
DECLARE_EISTRING (key);
DECLARE_EISTRING (text);
- for (i = 0 ; i < info_ptr->num_text ; i++)
- {
- /* How paranoid do I have to be about no trailing NULLs, and
- using (int)info_ptr->text[i].text_length, and strncpy and a temp
- string somewhere? */
- eireset(key);
- eireset(text);
- eicpy_ext(key, info_ptr->text[i].key, Qbinary);
- eicpy_ext(text, info_ptr->text[i].text, Qbinary);
+ if (png_get_text (png_ptr, info_ptr, &text_ptr, &num_text) > 0)
+ {
+ for (ii = 0 ; ii < num_text; ii++)
+ {
+ eireset (key);
+ eireset (text);
- warn_when_safe (Qpng, Qinfo, "%s - %s",
- eidata(key), eidata(text));
- }
+ eicpy_ext (key, text_ptr[ii].key, Qbinary);
+ eicpy_ext (text, text_ptr[ii].text, Qbinary);
+
+ warn_when_safe (Qpng, Qinfo, "%s - %s", eidata (key),
+ eidata (text));
+ }
+ }
}
xfree (row_pointers);
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Update png_instantiate () to work with more recent versions of libpng.
13 years, 1 month
Aidan Kehoe
Aidan Kehoe
changeset: 5372:6c3a695f54f5
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Mon Mar 14 21:04:45 2011 +0000
files: src/ChangeLog src/glyphs-eimage.c
description:
Update png_instantiate () to work with more recent versions of libpng.
2011-03-14 Aidan Kehoe <kehoea(a)parhasard.net>
* glyphs-eimage.c (png_instantiate):
Update the PNG handling code to work with versions of the library
where the png_info structure is no longer visible. Thank you for
the report, Robert Delius Royar.
diff -r 6f10ac29bf40 -r 6c3a695f54f5 src/ChangeLog
--- a/src/ChangeLog Sat Mar 12 13:11:31 2011 +0000
+++ b/src/ChangeLog Mon Mar 14 21:04:45 2011 +0000
＠＠ -1,3 +1,10 ＠＠
+2011-03-14 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * glyphs-eimage.c (png_instantiate):
+ Update the PNG handling code to work with versions of the library
+ where the png_info structure is no longer visible. Thank you for
+ the report, Robert Delius Royar.
+
2011-03-12 Aidan Kehoe <kehoea(a)parhasard.net>
* event-stream.c (Fdispatch_event):
diff -r 6f10ac29bf40 -r 6c3a695f54f5 src/glyphs-eimage.c
--- a/src/glyphs-eimage.c Sat Mar 12 13:11:31 2011 +0000
+++ b/src/glyphs-eimage.c Mon Mar 14 21:04:45 2011 +0000
＠＠ -982,8 +982,8 ＠＠
int y, padding;
Binbyte **row_pointers;
UINT_64_BIT pixels_sq;
- height = info_ptr->height;
- width = info_ptr->width;
+ height = png_get_image_height (png_ptr, info_ptr);
+ width = png_get_image_width (png_ptr, info_ptr);
pixels_sq = (UINT_64_BIT) width * (UINT_64_BIT) height;
if (pixels_sq > ((size_t) -1) / 3)
signal_image_error ("PNG image too large to instantiate", instantiator);
＠＠ -1044,30 +1044,37 ＠＠
/* Now that we're using EImage, ask for 8bit RGB triples for any type
of image*/
- /* convert palette images to RGB */
- if (info_ptr->color_type == PNG_COLOR_TYPE_PALETTE)
- png_set_palette_to_rgb (png_ptr);
- /* convert grayscale images to RGB */
- else if (info_ptr->color_type == PNG_COLOR_TYPE_GRAY ||
- info_ptr->color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
- png_set_gray_to_rgb (png_ptr);
- /* pad images with depth < 8 bits */
- else if (info_ptr->bit_depth < 8)
+ switch (png_get_color_type (png_ptr, info_ptr))
{
- if (info_ptr->color_type == PNG_COLOR_TYPE_GRAY)
- png_set_expand (png_ptr);
- else
- png_set_packing (png_ptr);
+ case PNG_COLOR_TYPE_PALETTE:
+ /* convert palette images to RGB */
+ png_set_palette_to_rgb (png_ptr);
+ break;
+
+ case PNG_COLOR_TYPE_GRAY:
+ case PNG_COLOR_TYPE_GRAY_ALPHA:
+ /* convert grayscale images to RGB */
+ png_set_gray_to_rgb (png_ptr);
+ break;
+
+ default:
+ /* pad images with depth < 8 bits */
+ if (png_get_bit_depth (png_ptr, info_ptr) < 8)
+ {
+ png_set_packing (png_ptr);
+ }
+ break;
}
+
/* strip 16-bit depth files down to 8 bits */
- if (info_ptr->bit_depth == 16)
+ if (png_get_bit_depth (png_ptr, info_ptr) == 16)
png_set_strip_16 (png_ptr);
/* strip alpha channel
#### shouldn't we handle this?
first call png_read_update_info in case above transformations
have generated an alpha channel */
png_read_update_info(png_ptr, info_ptr);
- if (info_ptr->color_type & PNG_COLOR_MASK_ALPHA)
+ if (png_get_color_type (png_ptr, info_ptr) & PNG_COLOR_MASK_ALPHA)
png_set_strip_alpha (png_ptr);
png_read_image (png_ptr, row_pointers);
＠＠ -1077,23 +1084,25 ＠＠
* into the glyph code, where you can get to it from lisp
* anyway. - WMP */
{
- int i;
+ int ii, num_text = 0;
+ png_textp text_ptr = NULL;
DECLARE_EISTRING (key);
DECLARE_EISTRING (text);
- for (i = 0 ; i < info_ptr->num_text ; i++)
- {
- /* How paranoid do I have to be about no trailing NULLs, and
- using (int)info_ptr->text[i].text_length, and strncpy and a temp
- string somewhere? */
- eireset(key);
- eireset(text);
- eicpy_ext(key, info_ptr->text[i].key, Qbinary);
- eicpy_ext(text, info_ptr->text[i].text, Qbinary);
+ if (png_get_text (png_ptr, info_ptr, &text_ptr, &num_text) > 0)
+ {
+ for (ii = 0 ; ii < num_text; ii++)
+ {
+ eireset (key);
+ eireset (text);
- warn_when_safe (Qpng, Qinfo, "%s - %s",
- eidata(key), eidata(text));
- }
+ eicpy_ext (key, text_ptr[ii].key, Qbinary);
+ eicpy_ext (text, text_ptr[ii].text, Qbinary);
+
+ warn_when_safe (Qpng, Qinfo, "%s - %s", eidata (key),
+ eidata (text));
+ }
+ }
}
xfree (row_pointers);
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Finally commit a version of the pgg-parse.el change that runs on non-mule
13 years, 1 month
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
xemacs-packages/pgg/ChangeLog addition:
2011-03-12 Aidan Kehoe <kehoea(a)parhasard.net>
* pgg-parse.el (pgg-parse-crc24, pgg-parse-crc24-string):
Call #'define-ccl-program at compile time, if available, not at
runtime. Addresses Marcus Crestani's problem of
http://mid.gmane.org/vpdhcif81o9.fsf＠informatik.uni-tuebingen.de .
XEmacs Packages source patch:
Diff command: cvs -q diff -Nu
Files affected: xemacs-packages/pgg/pgg-parse.el
Index: xemacs-packages/pgg/pgg-parse.el
===================================================================
RCS file: /cvsroot/xemacs/XEmacs/packages/xemacs-packages/pgg/pgg-parse.el,v
retrieving revision 1.7
diff -u -u -r1.7 pgg-parse.el
--- xemacs-packages/pgg/pgg-parse.el 26 Jan 2009 09:28:16 -0000 1.7
+++ xemacs-packages/pgg/pgg-parse.el 12 Mar 2011 16:46:44 -0000
＠＠ -35,7 +35,7 ＠＠
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl) (when (featurep 'mule) (require 'ccl)))
(defgroup pgg-parse ()
"OpenPGP packet parsing."
＠＠ -159,25 +159,43 ＠＠
(defmacro pgg-set-alist (alist key value)
`(setq ,alist (nconc ,alist (list (cons ,key ,value)))))
-(when (fboundp 'define-ccl-program)
+(defconst pgg-parse-crc24
+ (eval-when-compile
+ (let ((pre-existing
+ [1 30 14 114744 114775 0 161 131127 1 148217 15 82167 1 1848
+ 131159 1 1595 5 256 114743 390 114775 19707 1467 16 7 183 1 -5628
+ -7164 22]))
+ (when (fboundp 'ccl-compile)
+ (assert
+ (equal
+ pre-existing
+ (ccl-compile
+ '(1
+ ((loop
+ (read r0) (r1 ^= r0) (r2 ^= 0)
+ (r5 = 0)
+ (loop
+ (r1 <<= 1)
+ (r1 += ((r2 >> 15) & 1))
+ (r2 <<= 1)
+ (if (r1 & 256)
+ ((r1 ^= 390) (r2 ^= 19707)))
+ (if (r5 < 7)
+ ((r5 += 1)
+ (repeat))))
+ (repeat))))))
+ nil
+ "The pre-compiled CCL program appears broken, or the implementation
+of `ccl-compile' has changed compared to when this code was written. "))
+ pre-existing))
+ "A CCL program to parse CRC 24 checksums. See `define-ccl-program'.")
+
+(if (fboundp 'register-ccl-program)
+ (put 'pgg-parse-crc24 'ccl-program-idx
+ (register-ccl-program 'pgg-parse-crc24 pgg-parse-crc24)))
- (define-ccl-program pgg-parse-crc24
- '(1
- ((loop
- (read r0) (r1 ^= r0) (r2 ^= 0)
- (r5 = 0)
- (loop
- (r1 <<= 1)
- (r1 += ((r2 >> 15) & 1))
- (r2 <<= 1)
- (if (r1 & 256)
- ((r1 ^= 390) (r2 ^= 19707)))
- (if (r5 < 7)
- ((r5 += 1)
- (repeat))))
- (repeat)))))
-
- (defun pgg-parse-crc24-string (string)
+(defun pgg-parse-crc24-string (string)
+ (when (fboundp 'ccl-execute-on-string)
(let ((h (vector nil 183 1230 nil nil nil nil nil nil)))
(ccl-execute-on-string pgg-parse-crc24 h string)
(format "%c%c%c"
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Be better about searching for chars typed via XIM and x-compose.el, isearch
13 years, 1 month
Aidan Kehoe
Aidan Kehoe
changeset: 5371:6f10ac29bf40
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sat Mar 12 13:11:31 2011 +0000
files: lisp/ChangeLog lisp/isearch-mode.el src/ChangeLog src/event-stream.c
description:
Be better about searching for chars typed via XIM and x-compose.el, isearch
lisp/ChangeLog addition:
2011-03-12 Aidan Kehoe <kehoea(a)parhasard.net>
* isearch-mode.el (isearch-mode-map):
Document why we bind the ASCII characters to isearch-printing-char
in more detail.
* isearch-mode.el (isearch-maybe-frob-keyboard-macros):
If `this-command' is nil and the keys typed would normally be
bound to `self-insert-command' in the global map, force
`isearch-printing-char' to be called with an appropriate value for
last-command-event. Addresses an issue where searching for
characters generated from x-compose.el and XIM threw errors for me
in dired.
src/ChangeLog addition:
2011-03-12 Aidan Kehoe <kehoea(a)parhasard.net>
* event-stream.c (Fdispatch_event):
As documented, allow pre-command-hook to usefully modify
this-command even when this-command is nil (that is, we would
normally throw an undefined-keystroke-sequence error). Don't throw
that error if this-command was modified, instead try to execute
the new value.
Allow pre-command-hook to modify last-command-event in this
specific context. Don't document this, for the moment.
diff -r 4c4b96b13f70 -r 6f10ac29bf40 lisp/ChangeLog
--- a/lisp/ChangeLog Fri Mar 11 20:40:01 2011 +0000
+++ b/lisp/ChangeLog Sat Mar 12 13:11:31 2011 +0000
＠＠ -1,3 +1,16 ＠＠
+2011-03-12 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * isearch-mode.el (isearch-mode-map):
+ Document why we bind the ASCII characters to isearch-printing-char
+ in more detail.
+ * isearch-mode.el (isearch-maybe-frob-keyboard-macros):
+ If `this-command' is nil and the keys typed would normally be
+ bound to `self-insert-command' in the global map, force
+ `isearch-printing-char' to be called with an appropriate value for
+ last-command-event. Addresses an issue where searching for
+ characters generated from x-compose.el and XIM threw errors for me
+ in dired.
+
2011-03-10 Aidan Kehoe <kehoea(a)parhasard.net>
* etags.el (buffer-tag-table-list):
diff -r 4c4b96b13f70 -r 6f10ac29bf40 lisp/isearch-mode.el
--- a/lisp/isearch-mode.el Fri Mar 11 20:40:01 2011 +0000
+++ b/lisp/isearch-mode.el Sat Mar 12 13:11:31 2011 +0000
＠＠ -239,10 +239,18 ＠＠
(let ((map (make-keymap)))
(set-keymap-name map 'isearch-mode-map)
- ;; Bind all printing characters to `isearch-printing-char'.
- ;; This isn't normally necessary, but if a printing character were
- ;; bound to something other than self-insert-command in global-map,
- ;; then it would terminate the search and be executed without this.
+ ;; Bind ASCII printing characters to `isearch-printing-char'. This
+ ;; isn't normally necessary, but if a printing character were bound to
+ ;; something other than self-insert-command in global-map, then it would
+ ;; terminate the search and be executed without this.
+
+ ;; This is also relevant when other modes (notably dired and gnus) call
+ ;; `suppress-keymap' on their major mode maps; this means that
+ ;; `isearch-maybe-frob-keyboard-macros' won't pick up that the command
+ ;; that would normally be executed is `self-insert-command' and do its
+ ;; thing of transforming that to `isearch-printing-char'. This is less
+ ;; of an issue for the non-ASCII characters, because they rarely have
+ ;; specific bindings in major modes.
(let ((i 32)
(str (make-string 1 0)))
(while (< i 127)
＠＠ -1609,8 +1617,27 ＠＠
last-command-char (and (stringp this-command)
(aref this-command 0))
this-command 'isearch-printing-char))
- ))
-
+ ((and (null this-command)
+ (eq 'key-press (event-type last-command-event))
+ (current-local-map)
+ (let* ((this-command-keys (this-command-keys))
+ (this-command-keys (or (lookup-key function-key-map
+ this-command-keys)
+ this-command-keys))
+ (lookup-key (lookup-key global-map this-command-keys)))
+ (and (eq 'self-insert-command lookup-key)
+ ;; The feature here that a modification of
+ ;; last-command-event is respected is undocumented, and
+ ;; only applies when this-command is nil. The design
+ ;; isn't reat, and I welcome suggestions for a better
+ ;; one.
+ (setq last-command-event
+ (find-if 'key-press-event-p this-command-keys
+:from-end t)
+ last-command-char
+ (event-to-character last-command-event)
+ this-command 'isearch-printing-char)))))))
+
;;;========================================================
;;; Highlighting
diff -r 4c4b96b13f70 -r 6f10ac29bf40 src/ChangeLog
--- a/src/ChangeLog Fri Mar 11 20:40:01 2011 +0000
+++ b/src/ChangeLog Sat Mar 12 13:11:31 2011 +0000
＠＠ -1,3 +1,14 ＠＠
+2011-03-12 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * event-stream.c (Fdispatch_event):
+ As documented, allow pre-command-hook to usefully modify
+ this-command even when this-command is nil (that is, we would
+ normally throw an undefined-keystroke-sequence error). Don't throw
+ that error if this-command was modified, instead try to execute
+ the new value.
+ Allow pre-command-hook to modify last-command-event in this
+ specific context. Don't document this, for the moment.
+
2011-03-11 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecode.c (optimize_byte_code):
diff -r 4c4b96b13f70 -r 6f10ac29bf40 src/event-stream.c
--- a/src/event-stream.c Fri Mar 11 20:40:01 2011 +0000
+++ b/src/event-stream.c Sat Mar 12 13:11:31 2011 +0000
＠＠ -4445,6 +4445,7 ＠＠
{
Lisp_Object leaf = lookup_command_event (command_builder, event, 1);
+ lookedup:
if (KEYMAPP (leaf))
/* Incomplete key sequence */
break;
＠＠ -4524,6 +4525,22 ＠＠
GCPRO1 (keys);
pre_command_hook ();
UNGCPRO;
+
+ if (!NILP (Vthis_command))
+ {
+ /* Allow pre-command-hook to change the command to
+ something more useful, and avoid barfing. */
+ leaf = Vthis_command;
+ if (!EQ (command_builder->most_current_event,
+ Vlast_command_event))
+ {
+ reset_current_events (command_builder);
+ command_builder_append_event (command_builder,
+ Vlast_command_event);
+ }
+ goto lookedup;
+ }
+
/* The post-command-hook doesn't run. */
Fsignal (Qundefined_keystroke_sequence, list1 (keys));
}
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Address the easy test failures in tests/automated.
13 years, 1 month
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1299876001 0
# Node ID 4c4b96b13f70850c10a8ff4f8617b158b13971cd
# Parent 4141aeddc55bc1be01e8649810b136f7022208bc
Address the easy test failures in tests/automated.
src/ChangeLog addition:
2011-03-11 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecode.c (optimize_byte_code):
Only transform assignments to keywords to Bdiscard if
NEED_TO_HANDLE_21_4_CODE is turned on. Cf. similar code in
reject_constant_symbols().
tests/ChangeLog addition:
2011-03-11 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/byte-compiler-tests.el:
(defconst :foo 1) now gives a warning when byte-compiled, check
for that.
(setq :foo 1) now errors with interpreted code, but succeeds with
byte-compiled code; check for the former, wrap a
Known-Bug-Expect-Failure around a check for the error in the
latter case, we can't yet remove this behaviour while we're using
packages compiled by 21.4.
* automated/lisp-tests.el (wrong-type-argument):
Integer zero is a valid argument to #'substring-no-properties, use
Assert not Check-Error for it. Check some other aspects of the
functionality of #'substring-no-properties in passing.
diff -r 4141aeddc55b -r 4c4b96b13f70 src/ChangeLog
--- a/src/ChangeLog Thu Mar 10 19:14:25 2011 +0000
+++ b/src/ChangeLog Fri Mar 11 20:40:01 2011 +0000
＠＠ -1,3 +1,10 ＠＠
+2011-03-11 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * bytecode.c (optimize_byte_code):
+ Only transform assignments to keywords to Bdiscard if
+ NEED_TO_HANDLE_21_4_CODE is turned on. Cf. similar code in
+ reject_constant_symbols().
+
2011-02-24 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Fsubstring_no_properties):
diff -r 4141aeddc55b -r 4c4b96b13f70 src/bytecode.c
--- a/src/bytecode.c Thu Mar 10 19:14:25 2011 +0000
+++ b/src/bytecode.c Fri Mar 11 20:40:01 2011 +0000
＠＠ -1961,11 +1961,14 ＠＠
wtaerror ("attempt to set non-symbol", val);
if (EQ (val, Qnil) || EQ (val, Qt))
signal_error (Qsetting_constant, 0, val);
+#ifdef NEED_TO_HANDLE_21_4_CODE
/* Ignore assignments to keywords by converting to Bdiscard.
- For backward compatibility only - we'd like to make this an error. */
+ For backward compatibility only - we'd like to make this an
+ error. */
if (SYMBOL_IS_KEYWORD (val))
REWRITE_OPCODE (Bdiscard);
else
+#endif
WRITE_NARGS (Bvarset);
break;
diff -r 4141aeddc55b -r 4c4b96b13f70 tests/ChangeLog
--- a/tests/ChangeLog Thu Mar 10 19:14:25 2011 +0000
+++ b/tests/ChangeLog Fri Mar 11 20:40:01 2011 +0000
＠＠ -1,3 +1,18 ＠＠
+2011-03-11 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/byte-compiler-tests.el:
+ (defconst :foo 1) now gives a warning when byte-compiled, check
+ for that.
+ (setq :foo 1) now errors with interpreted code, but succeeds with
+ byte-compiled code; check for the former, wrap a
+ Known-Bug-Expect-Failure around a check for the error in the
+ latter case, we can't yet remove this behaviour while we're using
+ packages compiled by 21.4.
+ * automated/lisp-tests.el (wrong-type-argument):
+ Integer zero is a valid argument to #'substring-no-properties, use
+ Assert not Check-Error for it. Check some other aspects of the
+ functionality of #'substring-no-properties in passing.
+
2011-02-24 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el (substring-no-properties):
diff -r 4141aeddc55b -r 4c4b96b13f70 tests/automated/byte-compiler-tests.el
--- a/tests/automated/byte-compiler-tests.el Thu Mar 10 19:14:25 2011 +0000
+++ b/tests/automated/byte-compiler-tests.el Fri Mar 11 20:40:01 2011 +0000
＠＠ -45,7 +45,7 ＠＠
(check-byte-compiler-message "Attempt to set non-symbol" (setq 1 1))
(check-byte-compiler-message "Attempt to set constant symbol" (setq t 1))
(check-byte-compiler-message "Attempt to set constant symbol" (setq nil 1))
-(check-byte-compiler-message "^$" (defconst :foo 1))
+(check-byte-compiler-message "Attempt to set constant symbol" (defconst :foo 1))
(check-byte-compiler-message "Attempt to let-bind non-symbol" (let ((1 'x)) 1))
(check-byte-compiler-message "Attempt to let-bind constant symbol" (let ((t 'x)) (foo)))
＠＠ -60,12 +60,16 ＠＠
(check-byte-compiler-message "reference to free variable" (car free-variable))
(check-byte-compiler-message "called with 2 args, but requires 1" (car 'x 'y))
-(check-byte-compiler-message "^$" (setq :foo 1))
(let ((fun '(lambda () (setq :foo 1))))
(fset 'test-byte-compiler-fun fun))
(Check-Error setting-constant (test-byte-compiler-fun))
-(byte-compile 'test-byte-compiler-fun)
-(Check-Error setting-constant (test-byte-compiler-fun))
+(Check-Message "Attempt to set constant symbol"
+ (byte-compile 'test-byte-compiler-fun))
+
+;; Once NEED_TO_HANDLE_21_4_CODE is no longer defined in C, this will error
+;; correctly. It's disabled because the packages are compiled by 21.4.
+(Known-Bug-Expect-Failure
+ (Check-Error setting-constant (test-byte-compiler-fun)))
(eval-when-compile (defvar setq-test-foo nil) (defvar setq-test-bar nil))
(progn
diff -r 4141aeddc55b -r 4c4b96b13f70 tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el Thu Mar 10 19:14:25 2011 +0000
+++ b/tests/automated/lisp-tests.el Fri Mar 11 20:40:01 2011 +0000
＠＠ -1339,9 +1339,17 ＠＠
(Check-Error args-out-of-range (subseq [1 2 3] -42))
(Check-Error args-out-of-range (subseq [1 2 3] 0 42))
-(Check-Error wrong-type-argument (substring-no-properties nil 4))
-(Check-Error wrong-type-argument (substring-no-properties "hi there" pi))
-(Check-Error wrong-type-argument (substring-no-properties "hi there" 0))
+(let ((string "hi there"))
+ (Assert (equal (substring-no-properties "123" 0) "123"))
+ (Assert (equal (substring-no-properties "1234" -3 -1) "23"))
+ (Assert (equal (substring-no-properties "hi there" 0) "hi there"))
+ (put-text-property 0 (length string) 'foo 'bar string)
+ (Assert (eq 'bar (get-text-property 0 'foo string)))
+ (Assert (not
+ (get-text-property 0 'foo (substring-no-properties "hi there" 0))))
+ (Check-Error wrong-type-argument (substring-no-properties nil 4))
+ (Check-Error wrong-type-argument (substring-no-properties "hi there" pi))
+ (Check-Error wrong-type-argument (substring-no-properties "hi there" 0.0)))
;;-----------------------------------------------------
;; Time-related tests
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Address the easy test failures in tests/automated.
13 years, 1 month
Aidan Kehoe
Aidan Kehoe
changeset: 5370:4c4b96b13f70
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Fri Mar 11 20:40:01 2011 +0000
files: src/ChangeLog src/bytecode.c tests/ChangeLog tests/automated/byte-compiler-tests.el tests/automated/lisp-tests.el
description:
Address the easy test failures in tests/automated.
src/ChangeLog addition:
2011-03-11 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecode.c (optimize_byte_code):
Only transform assignments to keywords to Bdiscard if
NEED_TO_HANDLE_21_4_CODE is turned on. Cf. similar code in
reject_constant_symbols().
tests/ChangeLog addition:
2011-03-11 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/byte-compiler-tests.el:
(defconst :foo 1) now gives a warning when byte-compiled, check
for that.
(setq :foo 1) now errors with interpreted code, but succeeds with
byte-compiled code; check for the former, wrap a
Known-Bug-Expect-Failure around a check for the error in the
latter case, we can't yet remove this behaviour while we're using
packages compiled by 21.4.
* automated/lisp-tests.el (wrong-type-argument):
Integer zero is a valid argument to #'substring-no-properties, use
Assert not Check-Error for it. Check some other aspects of the
functionality of #'substring-no-properties in passing.
diff -r 4141aeddc55b -r 4c4b96b13f70 src/ChangeLog
--- a/src/ChangeLog Thu Mar 10 19:14:25 2011 +0000
+++ b/src/ChangeLog Fri Mar 11 20:40:01 2011 +0000
＠＠ -1,3 +1,10 ＠＠
+2011-03-11 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * bytecode.c (optimize_byte_code):
+ Only transform assignments to keywords to Bdiscard if
+ NEED_TO_HANDLE_21_4_CODE is turned on. Cf. similar code in
+ reject_constant_symbols().
+
2011-02-24 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Fsubstring_no_properties):
diff -r 4141aeddc55b -r 4c4b96b13f70 src/bytecode.c
--- a/src/bytecode.c Thu Mar 10 19:14:25 2011 +0000
+++ b/src/bytecode.c Fri Mar 11 20:40:01 2011 +0000
＠＠ -1961,11 +1961,14 ＠＠
wtaerror ("attempt to set non-symbol", val);
if (EQ (val, Qnil) || EQ (val, Qt))
signal_error (Qsetting_constant, 0, val);
+#ifdef NEED_TO_HANDLE_21_4_CODE
/* Ignore assignments to keywords by converting to Bdiscard.
- For backward compatibility only - we'd like to make this an error. */
+ For backward compatibility only - we'd like to make this an
+ error. */
if (SYMBOL_IS_KEYWORD (val))
REWRITE_OPCODE (Bdiscard);
else
+#endif
WRITE_NARGS (Bvarset);
break;
diff -r 4141aeddc55b -r 4c4b96b13f70 tests/ChangeLog
--- a/tests/ChangeLog Thu Mar 10 19:14:25 2011 +0000
+++ b/tests/ChangeLog Fri Mar 11 20:40:01 2011 +0000
＠＠ -1,3 +1,18 ＠＠
+2011-03-11 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/byte-compiler-tests.el:
+ (defconst :foo 1) now gives a warning when byte-compiled, check
+ for that.
+ (setq :foo 1) now errors with interpreted code, but succeeds with
+ byte-compiled code; check for the former, wrap a
+ Known-Bug-Expect-Failure around a check for the error in the
+ latter case, we can't yet remove this behaviour while we're using
+ packages compiled by 21.4.
+ * automated/lisp-tests.el (wrong-type-argument):
+ Integer zero is a valid argument to #'substring-no-properties, use
+ Assert not Check-Error for it. Check some other aspects of the
+ functionality of #'substring-no-properties in passing.
+
2011-02-24 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el (substring-no-properties):
diff -r 4141aeddc55b -r 4c4b96b13f70 tests/automated/byte-compiler-tests.el
--- a/tests/automated/byte-compiler-tests.el Thu Mar 10 19:14:25 2011 +0000
+++ b/tests/automated/byte-compiler-tests.el Fri Mar 11 20:40:01 2011 +0000
＠＠ -45,7 +45,7 ＠＠
(check-byte-compiler-message "Attempt to set non-symbol" (setq 1 1))
(check-byte-compiler-message "Attempt to set constant symbol" (setq t 1))
(check-byte-compiler-message "Attempt to set constant symbol" (setq nil 1))
-(check-byte-compiler-message "^$" (defconst :foo 1))
+(check-byte-compiler-message "Attempt to set constant symbol" (defconst :foo 1))
(check-byte-compiler-message "Attempt to let-bind non-symbol" (let ((1 'x)) 1))
(check-byte-compiler-message "Attempt to let-bind constant symbol" (let ((t 'x)) (foo)))
＠＠ -60,12 +60,16 ＠＠
(check-byte-compiler-message "reference to free variable" (car free-variable))
(check-byte-compiler-message "called with 2 args, but requires 1" (car 'x 'y))
-(check-byte-compiler-message "^$" (setq :foo 1))
(let ((fun '(lambda () (setq :foo 1))))
(fset 'test-byte-compiler-fun fun))
(Check-Error setting-constant (test-byte-compiler-fun))
-(byte-compile 'test-byte-compiler-fun)
-(Check-Error setting-constant (test-byte-compiler-fun))
+(Check-Message "Attempt to set constant symbol"
+ (byte-compile 'test-byte-compiler-fun))
+
+;; Once NEED_TO_HANDLE_21_4_CODE is no longer defined in C, this will error
+;; correctly. It's disabled because the packages are compiled by 21.4.
+(Known-Bug-Expect-Failure
+ (Check-Error setting-constant (test-byte-compiler-fun)))
(eval-when-compile (defvar setq-test-foo nil) (defvar setq-test-bar nil))
(progn
diff -r 4141aeddc55b -r 4c4b96b13f70 tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el Thu Mar 10 19:14:25 2011 +0000
+++ b/tests/automated/lisp-tests.el Fri Mar 11 20:40:01 2011 +0000
＠＠ -1339,9 +1339,17 ＠＠
(Check-Error args-out-of-range (subseq [1 2 3] -42))
(Check-Error args-out-of-range (subseq [1 2 3] 0 42))
-(Check-Error wrong-type-argument (substring-no-properties nil 4))
-(Check-Error wrong-type-argument (substring-no-properties "hi there" pi))
-(Check-Error wrong-type-argument (substring-no-properties "hi there" 0))
+(let ((string "hi there"))
+ (Assert (equal (substring-no-properties "123" 0) "123"))
+ (Assert (equal (substring-no-properties "1234" -3 -1) "23"))
+ (Assert (equal (substring-no-properties "hi there" 0) "hi there"))
+ (put-text-property 0 (length string) 'foo 'bar string)
+ (Assert (eq 'bar (get-text-property 0 'foo string)))
+ (Assert (not
+ (get-text-property 0 'foo (substring-no-properties "hi there" 0))))
+ (Check-Error wrong-type-argument (substring-no-properties nil 4))
+ (Check-Error wrong-type-argument (substring-no-properties "hi there" pi))
+ (Check-Error wrong-type-argument (substring-no-properties "hi there" 0.0)))
;;-----------------------------------------------------
;; Time-related tests
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Eliminate byte-compile warnings, core Lisp.
13 years, 1 month
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1299784465 0
# Node ID 4141aeddc55bc1be01e8649810b136f7022208bc
# Parent ed74d2ca7082ba4e2478792b7ba2a70a34899d25
Eliminate byte-compile warnings, core Lisp.
2011-03-10 Aidan Kehoe <kehoea(a)parhasard.net>
* etags.el (buffer-tag-table-list):
* files.el (find-file-read-only):
* files.el (find-file-read-only-other-window):
* info.el (Info-dir-outdated-p):
* info.el (Info-dump-dir-entries):
* info.el (Info-rebuild-dir):
* menubar-items.el (default-menubar):
* mouse.el (drag-window-divider):
* mouse.el (vertical-divider-map):
* test-harness.el (emacs-lisp-file-regexp):
Eliminate byte-compile warnings, again aside from those linked to
Stephen's various non-defined fontconfig functions.
diff -r ed74d2ca7082 -r 4141aeddc55b lisp/ChangeLog
--- a/lisp/ChangeLog Thu Mar 10 18:51:15 2011 +0000
+++ b/lisp/ChangeLog Thu Mar 10 19:14:25 2011 +0000
＠＠ -1,3 +1,18 ＠＠
+2011-03-10 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * etags.el (buffer-tag-table-list):
+ * files.el (find-file-read-only):
+ * files.el (find-file-read-only-other-window):
+ * info.el (Info-dir-outdated-p):
+ * info.el (Info-dump-dir-entries):
+ * info.el (Info-rebuild-dir):
+ * menubar-items.el (default-menubar):
+ * mouse.el (drag-window-divider):
+ * mouse.el (vertical-divider-map):
+ * test-harness.el (emacs-lisp-file-regexp):
+ Eliminate byte-compile warnings, again aside from those linked to
+ Stephen's various non-defined fontconfig functions.
+
2011-03-10 Aidan Kehoe <kehoea(a)parhasard.net>
* cmdloop.el (yes-or-no-p):
diff -r ed74d2ca7082 -r 4141aeddc55b lisp/etags.el
--- a/lisp/etags.el Thu Mar 10 18:51:15 2011 +0000
+++ b/lisp/etags.el Thu Mar 10 19:14:25 2011 +0000
＠＠ -250,8 +250,8 ＠＠
(and (file-readable-p name)
;; get-tag-table-buffer has side-effects
(list (symbol-value-in-buffer 'buffer-file-name
- (get-tag-table-buffer name))))))
- result)
+ (get-tag-table-buffer name)))))
+ result))
;; If no TAGS file has been found, ask the user explicitly.
;; #### tags-file-name is *evil*.
(or result tags-file-name
diff -r ed74d2ca7082 -r 4141aeddc55b lisp/files.el
--- a/lisp/files.el Thu Mar 10 18:51:15 2011 +0000
+++ b/lisp/files.el Thu Mar 10 19:14:25 2011 +0000
＠＠ -998,9 +998,9 ＠＠
(read-coding-system "Coding system: "))
t))
(let ((value (find-file filename codesys wildcards)))
- (mapcar #'(lambda (buffer)
- (set-symbol-value-in-buffer 'buffer-read-only t buffer))
- (if (listp value) value (list value)))
+ (mapc #'(lambda (buffer)
+ (set-symbol-value-in-buffer 'buffer-read-only t buffer))
+ (if (listp value) value (list value)))
value))
(defun find-file-read-only-other-window (filename &optional codesys wildcards)
diff -r ed74d2ca7082 -r 4141aeddc55b lisp/info.el
--- a/lisp/info.el Thu Mar 10 18:51:15 2011 +0000
+++ b/lisp/info.el Thu Mar 10 19:14:25 2011 +0000
＠＠ -1127,7 +1127,7 ＠＠
(let ((dir-mod-time (nth 5 (file-attributes file)))
f-mod-time newer)
(setq Info-dir-newer-info-files nil)
- (mapcar
+ (mapc
#'(lambda (f)
(prog2
(setq f-mod-time (nth 5 (file-attributes f)))
＠＠ -1191,23 +1191,23 ＠＠
(let ((tab-width 8)
(description-col 0)
len)
- (mapcar #'(lambda (e)
- (setq e (cdr e)) ; Drop filename
- (setq len (length (concat (car e)
- (car (cdr e)))))
- (if (> len description-col)
- (setq description-col len)))
- entries)
+ (mapc #'(lambda (e)
+ (setq e (cdr e)) ; Drop filename
+ (setq len (length (concat (car e)
+ (car (cdr e)))))
+ (if (> len description-col)
+ (setq description-col len)))
+ entries)
(setq description-col (+ 5 description-col))
- (mapcar #'(lambda (e)
- (setq e (cdr e)) ; Drop filename
- (insert "* " (car e) ":" (car (cdr e)))
- (setq e (car (cdr (cdr e))))
- (while e
- (indent-to-column description-col)
- (insert (car e) "\n")
- (setq e (cdr e))))
- entries)
+ (mapc #'(lambda (e)
+ (setq e (cdr e)) ; Drop filename
+ (insert "* " (car e) ":" (car (cdr e)))
+ (setq e (car (cdr (cdr e))))
+ (while e
+ (indent-to-column description-col)
+ (insert (car e) "\n")
+ (setq e (cdr e))))
+ entries)
(insert "\n")))
＠＠ -1299,7 +1299,7 ＠＠
(narrow-to-region mark next-section)
(setq dir-section-contents (nreverse (Info-parse-dir-entries
(point-min) (point-max))))
- (mapcar
+ (mapc
#'(lambda (file)
(setq dir-entry (assoc (downcase
(file-name-sans-extension
diff -r ed74d2ca7082 -r 4141aeddc55b lisp/menubar-items.el
--- a/lisp/menubar-items.el Thu Mar 10 18:51:15 2011 +0000
+++ b/lisp/menubar-items.el Thu Mar 10 19:14:25 2011 +0000
＠＠ -262,7 +262,7 ＠＠
(submenu-generate-accelerator-spec
(mapcar #'(lambda (bmk)
`[,bmk (bookmark-delete ',bmk)])
- (bookmark-all-names)))))
+ (declare-fboundp (bookmark-all-names))))))
["%_Edit Bookmark List" bookmark-bmenu-list
:active (and-boundp 'bookmark-alist bookmark-alist)]
"---"
diff -r ed74d2ca7082 -r 4141aeddc55b lisp/mouse.el
--- a/lisp/mouse.el Thu Mar 10 18:51:15 2011 +0000
+++ b/lisp/mouse.el Thu Mar 10 19:14:25 2011 +0000
＠＠ -1781,22 +1781,24 ＠＠
(let ((all-that-bad nil)
(new-left-ok nil)
(new-right-ok nil))
- (mapcar* (lambda (window old-edges)
- (let ((new (car (window-pixel-edges window))))
- (if (/= new (car old-edges))
- (if (and new-left-ok
- (/= new-left-ok new))
- (setq all-that-bad t)
- (setq new-left-ok new)))))
- (window-list) old-edges-all-windows)
- (mapcar* (lambda (window old-edges)
- (let ((new (caddr (window-pixel-edges window))))
- (if (/= new (caddr old-edges))
- (if (and new-right-ok
- (/= new-right-ok new))
- (setq all-that-bad t)
- (setq new-right-ok new)))))
- (window-list) old-edges-all-windows)
+ (mapc (lambda (window old-edges)
+ (let ((new
+ (car (window-pixel-edges window))))
+ (if (/= new (car old-edges))
+ (if (and new-left-ok
+ (/= new-left-ok new))
+ (setq all-that-bad t)
+ (setq new-left-ok new)))))
+ (window-list) old-edges-all-windows)
+ (mapc (lambda (window old-edges)
+ (let ((new
+ (caddr (window-pixel-edges window))))
+ (if (/= new (caddr old-edges))
+ (if (and new-right-ok
+ (/= new-right-ok new))
+ (setq all-that-bad t)
+ (setq new-right-ok new)))))
+ (window-list) old-edges-all-windows)
all-that-bad))
(set-window-configuration backup-conf)))))))))
diff -r ed74d2ca7082 -r 4141aeddc55b lisp/test-harness.el
--- a/lisp/test-harness.el Thu Mar 10 18:51:15 2011 +0000
+++ b/lisp/test-harness.el Thu Mar 10 19:14:25 2011 +0000
＠＠ -128,7 +128,7 ＠＠
(defvar test-harness-current-file nil)
-(defvar emacs-lisp-file-regexp (purecopy "\\.el\\'")
+(defvar emacs-lisp-file-regexp "\\.el\\'"
"*Regexp which matches Emacs Lisp source files.")
(defconst test-harness-file-summary-template
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Eliminate byte-compile warnings, core Lisp.
13 years, 1 month
Aidan Kehoe
Aidan Kehoe
changeset: 5369:4141aeddc55b
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Thu Mar 10 19:14:25 2011 +0000
files: lisp/ChangeLog lisp/etags.el lisp/files.el lisp/info.el lisp/menubar-items.el lisp/mouse.el lisp/test-harness.el
description:
Eliminate byte-compile warnings, core Lisp.
2011-03-10 Aidan Kehoe <kehoea(a)parhasard.net>
* etags.el (buffer-tag-table-list):
* files.el (find-file-read-only):
* files.el (find-file-read-only-other-window):
* info.el (Info-dir-outdated-p):
* info.el (Info-dump-dir-entries):
* info.el (Info-rebuild-dir):
* menubar-items.el (default-menubar):
* mouse.el (drag-window-divider):
* mouse.el (vertical-divider-map):
* test-harness.el (emacs-lisp-file-regexp):
Eliminate byte-compile warnings, again aside from those linked to
Stephen's various non-defined fontconfig functions.
diff -r ed74d2ca7082 -r 4141aeddc55b lisp/ChangeLog
--- a/lisp/ChangeLog Thu Mar 10 18:51:15 2011 +0000
+++ b/lisp/ChangeLog Thu Mar 10 19:14:25 2011 +0000
＠＠ -1,3 +1,18 ＠＠
+2011-03-10 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * etags.el (buffer-tag-table-list):
+ * files.el (find-file-read-only):
+ * files.el (find-file-read-only-other-window):
+ * info.el (Info-dir-outdated-p):
+ * info.el (Info-dump-dir-entries):
+ * info.el (Info-rebuild-dir):
+ * menubar-items.el (default-menubar):
+ * mouse.el (drag-window-divider):
+ * mouse.el (vertical-divider-map):
+ * test-harness.el (emacs-lisp-file-regexp):
+ Eliminate byte-compile warnings, again aside from those linked to
+ Stephen's various non-defined fontconfig functions.
+
2011-03-10 Aidan Kehoe <kehoea(a)parhasard.net>
* cmdloop.el (yes-or-no-p):
diff -r ed74d2ca7082 -r 4141aeddc55b lisp/etags.el
--- a/lisp/etags.el Thu Mar 10 18:51:15 2011 +0000
+++ b/lisp/etags.el Thu Mar 10 19:14:25 2011 +0000
＠＠ -250,8 +250,8 ＠＠
(and (file-readable-p name)
;; get-tag-table-buffer has side-effects
(list (symbol-value-in-buffer 'buffer-file-name
- (get-tag-table-buffer name))))))
- result)
+ (get-tag-table-buffer name)))))
+ result))
;; If no TAGS file has been found, ask the user explicitly.
;; #### tags-file-name is *evil*.
(or result tags-file-name
diff -r ed74d2ca7082 -r 4141aeddc55b lisp/files.el
--- a/lisp/files.el Thu Mar 10 18:51:15 2011 +0000
+++ b/lisp/files.el Thu Mar 10 19:14:25 2011 +0000
＠＠ -998,9 +998,9 ＠＠
(read-coding-system "Coding system: "))
t))
(let ((value (find-file filename codesys wildcards)))
- (mapcar #'(lambda (buffer)
- (set-symbol-value-in-buffer 'buffer-read-only t buffer))
- (if (listp value) value (list value)))
+ (mapc #'(lambda (buffer)
+ (set-symbol-value-in-buffer 'buffer-read-only t buffer))
+ (if (listp value) value (list value)))
value))
(defun find-file-read-only-other-window (filename &optional codesys wildcards)
diff -r ed74d2ca7082 -r 4141aeddc55b lisp/info.el
--- a/lisp/info.el Thu Mar 10 18:51:15 2011 +0000
+++ b/lisp/info.el Thu Mar 10 19:14:25 2011 +0000
＠＠ -1127,7 +1127,7 ＠＠
(let ((dir-mod-time (nth 5 (file-attributes file)))
f-mod-time newer)
(setq Info-dir-newer-info-files nil)
- (mapcar
+ (mapc
#'(lambda (f)
(prog2
(setq f-mod-time (nth 5 (file-attributes f)))
＠＠ -1191,23 +1191,23 ＠＠
(let ((tab-width 8)
(description-col 0)
len)
- (mapcar #'(lambda (e)
- (setq e (cdr e)) ; Drop filename
- (setq len (length (concat (car e)
- (car (cdr e)))))
- (if (> len description-col)
- (setq description-col len)))
- entries)
+ (mapc #'(lambda (e)
+ (setq e (cdr e)) ; Drop filename
+ (setq len (length (concat (car e)
+ (car (cdr e)))))
+ (if (> len description-col)
+ (setq description-col len)))
+ entries)
(setq description-col (+ 5 description-col))
- (mapcar #'(lambda (e)
- (setq e (cdr e)) ; Drop filename
- (insert "* " (car e) ":" (car (cdr e)))
- (setq e (car (cdr (cdr e))))
- (while e
- (indent-to-column description-col)
- (insert (car e) "\n")
- (setq e (cdr e))))
- entries)
+ (mapc #'(lambda (e)
+ (setq e (cdr e)) ; Drop filename
+ (insert "* " (car e) ":" (car (cdr e)))
+ (setq e (car (cdr (cdr e))))
+ (while e
+ (indent-to-column description-col)
+ (insert (car e) "\n")
+ (setq e (cdr e))))
+ entries)
(insert "\n")))
＠＠ -1299,7 +1299,7 ＠＠
(narrow-to-region mark next-section)
(setq dir-section-contents (nreverse (Info-parse-dir-entries
(point-min) (point-max))))
- (mapcar
+ (mapc
#'(lambda (file)
(setq dir-entry (assoc (downcase
(file-name-sans-extension
diff -r ed74d2ca7082 -r 4141aeddc55b lisp/menubar-items.el
--- a/lisp/menubar-items.el Thu Mar 10 18:51:15 2011 +0000
+++ b/lisp/menubar-items.el Thu Mar 10 19:14:25 2011 +0000
＠＠ -262,7 +262,7 ＠＠
(submenu-generate-accelerator-spec
(mapcar #'(lambda (bmk)
`[,bmk (bookmark-delete ',bmk)])
- (bookmark-all-names)))))
+ (declare-fboundp (bookmark-all-names))))))
["%_Edit Bookmark List" bookmark-bmenu-list
:active (and-boundp 'bookmark-alist bookmark-alist)]
"---"
diff -r ed74d2ca7082 -r 4141aeddc55b lisp/mouse.el
--- a/lisp/mouse.el Thu Mar 10 18:51:15 2011 +0000
+++ b/lisp/mouse.el Thu Mar 10 19:14:25 2011 +0000
＠＠ -1781,22 +1781,24 ＠＠
(let ((all-that-bad nil)
(new-left-ok nil)
(new-right-ok nil))
- (mapcar* (lambda (window old-edges)
- (let ((new (car (window-pixel-edges window))))
- (if (/= new (car old-edges))
- (if (and new-left-ok
- (/= new-left-ok new))
- (setq all-that-bad t)
- (setq new-left-ok new)))))
- (window-list) old-edges-all-windows)
- (mapcar* (lambda (window old-edges)
- (let ((new (caddr (window-pixel-edges window))))
- (if (/= new (caddr old-edges))
- (if (and new-right-ok
- (/= new-right-ok new))
- (setq all-that-bad t)
- (setq new-right-ok new)))))
- (window-list) old-edges-all-windows)
+ (mapc (lambda (window old-edges)
+ (let ((new
+ (car (window-pixel-edges window))))
+ (if (/= new (car old-edges))
+ (if (and new-left-ok
+ (/= new-left-ok new))
+ (setq all-that-bad t)
+ (setq new-left-ok new)))))
+ (window-list) old-edges-all-windows)
+ (mapc (lambda (window old-edges)
+ (let ((new
+ (caddr (window-pixel-edges window))))
+ (if (/= new (caddr old-edges))
+ (if (and new-right-ok
+ (/= new-right-ok new))
+ (setq all-that-bad t)
+ (setq new-right-ok new)))))
+ (window-list) old-edges-all-windows)
all-that-bad))
(set-window-configuration backup-conf)))))))))
diff -r ed74d2ca7082 -r 4141aeddc55b lisp/test-harness.el
--- a/lisp/test-harness.el Thu Mar 10 18:51:15 2011 +0000
+++ b/lisp/test-harness.el Thu Mar 10 19:14:25 2011 +0000
＠＠ -128,7 +128,7 ＠＠
(defvar test-harness-current-file nil)
-(defvar emacs-lisp-file-regexp (purecopy "\\.el\\'")
+(defvar emacs-lisp-file-regexp "\\.el\\'"
"*Regexp which matches Emacs Lisp source files.")
(defconst test-harness-file-summary-template
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Use Common Lisp-derived builtins in a few more places in core Lisp.
13 years, 1 month
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1299628641 0
# Node ID 8b70d37ab80e0e3c333f31b3e8f9cf6ee6315279
# Parent f00192e1cd49e8004d1dc7cfbc025727c7010167
Use Common Lisp-derived builtins in a few more places in core Lisp.
2011-03-08 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el:
* cl-macs.el (loop):
* cl-macs.el (cl-expand-do-loop):
* cl-macs.el (shiftf):
* cl-macs.el (rotatef):
* cl-macs.el (assert):
* cl-macs.el (cl-defsubst-expand):
* etags.el (buffer-tag-table-list):
* frame.el:
* frame.el (frame-notice-user-settings):
* frame.el (minibuffer-frame-list):
* frame.el (get-frame-for-buffer-noselect):
Use Common Lisp-derived builtins in a few more places, none of
them performance-critical, but the style is better.
diff -r f00192e1cd49 -r 8b70d37ab80e lisp/ChangeLog
--- a/lisp/ChangeLog Tue Mar 08 23:41:52 2011 +0000
+++ b/lisp/ChangeLog Tue Mar 08 23:57:21 2011 +0000
＠＠ -1,3 +1,20 ＠＠
+2011-03-08 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-macs.el:
+ * cl-macs.el (loop):
+ * cl-macs.el (cl-expand-do-loop):
+ * cl-macs.el (shiftf):
+ * cl-macs.el (rotatef):
+ * cl-macs.el (assert):
+ * cl-macs.el (cl-defsubst-expand):
+ * etags.el (buffer-tag-table-list):
+ * frame.el:
+ * frame.el (frame-notice-user-settings):
+ * frame.el (minibuffer-frame-list):
+ * frame.el (get-frame-for-buffer-noselect):
+ Use Common Lisp-derived builtins in a few more places, none of
+ them performance-critical, but the style is better.
+
2011-03-08 Aidan Kehoe <kehoea(a)parhasard.net>
* buff-menu.el (list-buffers-noselect):
diff -r f00192e1cd49 -r 8b70d37ab80e lisp/cl-macs.el
--- a/lisp/cl-macs.el Tue Mar 08 23:41:52 2011 +0000
+++ b/lisp/cl-macs.el Tue Mar 08 23:57:21 2011 +0000
＠＠ -1066,7 +1066,7 ＠＠
Specify the name for block surrounding the loop, in place of nil.
(See `block'.)
"
- (if (not (memq t (mapcar 'symbolp (delq nil (delq t (copy-list clauses))))))
+ (if (notany #'symbolp (set-difference clauses '(nil t)))
(list 'block nil (list* 'while t clauses))
(let ((loop-name nil) (loop-bindings nil)
(loop-body nil) (loop-steps nil)
＠＠ -1648,12 +1648,12 ＠＠
steps)
(list* 'while (list 'not (car endtest))
(append body
- (let ((sets (mapcar
+ (let ((sets (mapcan
#'(lambda (c)
(and (consp c) (cdr (cdr c))
- (list (car c) (nth 2 c))))
+ (list
+ (list (car c) (nth 2 c)))))
steps)))
- (setq sets (delq nil sets))
(and sets
(list (cons (if (or star (not (cdr sets)))
'setq 'psetq)
＠＠ -2579,7 +2579,7 ＠＠
Example: (shiftf A B C) sets A to B, B to C, and returns the old A.
Each PLACE may be a symbol, or any generalized variable allowed by `setf'."
;; XEmacs change: use iteration instead of recursion
- (if (not (memq nil (mapcar 'symbolp (butlast (cons place args)))))
+ (if (every #'symbolp (butlast (cons place args)))
(list* 'prog1 place
(let ((sets nil))
(while args
＠＠ -2600,7 +2600,7 ＠＠
"Rotate left among PLACES.
Example: (rotatef A B C) sets A to B, B to C, and C to A. It returns nil.
Each PLACE may be a symbol, or any generalized variable allowed by `setf'."
- (if (not (memq nil (mapcar 'symbolp places)))
+ (if (every #'symbolp places)
(and (cdr places)
(let ((sets nil)
(first (car places)))
＠＠ -3127,11 +3127,7 ＠＠
omitted, a default message listing FORM itself is used."
(and (or (not (cl-compiling-file))
(< cl-optimize-speed 3) (= cl-optimize-safety 3))
- (let ((sargs (and show-args (delq nil (mapcar
- #'(lambda (x)
- (and (not (cl-const-expr-p x))
- x))
- (cdr form))))))
+ (let ((sargs (and show-args (remove-if #'cl-const-expr-p (cdr form)))))
(list 'progn
(list 'or form
(if string
＠＠ -3226,13 +3222,12 ＠＠
(defun cl-defsubst-expand (argns body simple whole unsafe &rest argvs)
(if (and whole (not (cl-safe-expr-p (cons 'progn argvs)))) whole
(if (cl-simple-exprs-p argvs) (setq simple t))
- (let ((lets (delq nil
- (mapcar* #'(lambda (argn argv)
- (if (or simple (cl-const-expr-p argv))
- (progn (setq body (subst argv argn body))
- (and unsafe (list argn argv)))
- (list argn argv)))
- argns argvs))))
+ (let ((lets (mapcan #'(lambda (argn argv)
+ (if (or simple (cl-const-expr-p argv))
+ (progn (setq body (subst argv argn body))
+ (and unsafe (list (list argn argv))))
+ (list (list argn argv))))
+ argns argvs)))
(if lets (list 'let lets body) body))))
diff -r f00192e1cd49 -r 8b70d37ab80e lisp/etags.el
--- a/lisp/etags.el Tue Mar 08 23:41:52 2011 +0000
+++ b/lisp/etags.el Tue Mar 08 23:57:21 2011 +0000
＠＠ -243,16 +243,15 ＠＠
(push expression result)
(error "Expression in tag-table-alist evaluated to non-string")))))
(setq result
- (mapcar
+ (mapcan
(lambda (name)
(when (file-directory-p name)
(setq name (concat (file-name-as-directory name) "TAGS")))
(and (file-readable-p name)
;; get-tag-table-buffer has side-effects
- (symbol-value-in-buffer 'buffer-file-name
- (get-tag-table-buffer name))))
- result))
- (setq result (delq nil result))
+ (list (symbol-value-in-buffer 'buffer-file-name
+ (get-tag-table-buffer name))))))
+ result)
;; If no TAGS file has been found, ask the user explicitly.
;; #### tags-file-name is *evil*.
(or result tags-file-name
diff -r f00192e1cd49 -r 8b70d37ab80e lisp/frame.el
--- a/lisp/frame.el Tue Mar 08 23:41:52 2011 +0000
+++ b/lisp/frame.el Tue Mar 08 23:57:21 2011 +0000
＠＠ -475,12 +475,13 ＠＠
;; onto a new frame. The default-minibuffer-frame
;; variable must be handled similarly.
(let ((users-of-initial
- (filtered-frame-list
+ (remove-if-not
#'(lambda (frame)
(and (not (eq frame frame-initial-frame))
(eq (window-frame
(minibuffer-window frame))
- frame-initial-frame))))))
+ frame-initial-frame)))
+ (frame-list))))
(if (or users-of-initial
(eq default-minibuffer-frame frame-initial-frame))
＠＠ -488,10 +489,11 ＠＠
;; are only minibuffers.
(let* ((new-surrogate
(car
- (or (filtered-frame-list
+ (or (remove-if-not
#'(lambda (frame)
(eq 'only
- (frame-property frame 'minibuffer))))
+ (frame-property frame 'minibuffer)))
+ (frame-list))
(minibuffer-frame-list))))
(new-minibuffer (minibuffer-window new-surrogate)))
＠＠ -674,29 +676,22 ＠＠
;; XEmacs change: Emacs has make-frame here. We have it in C, so no need for
;; frame-creation-function.
-;; XEmacs addition: support optional DEVICE argument.
+;; XEmacs addition: support optional DEVICE argument, use delete-if-not.
(defun filtered-frame-list (predicate &optional device)
"Return a list of all live frames which satisfy PREDICATE.
If optional second arg DEVICE is non-nil, restrict the frames
returned to that device."
- (let ((frames (if device (device-frame-list device)
- (frame-list)))
- good-frames)
- (while (consp frames)
- (if (funcall predicate (car frames))
- (setq good-frames (cons (car frames) good-frames)))
- (setq frames (cdr frames)))
- good-frames))
+ (delete-if-not predicate
+ (if device (device-frame-list device) (frame-list))))
;; XEmacs addition: support optional DEVICE argument.
(defun minibuffer-frame-list (&optional device)
"Return a list of all frames with their own minibuffers.
If optional second arg DEVICE is non-nil, restrict the frames
returned to that device."
- (filtered-frame-list
- #'(lambda (frame)
- (eq frame (window-frame (minibuffer-window frame))))
- device))
+ (delete-if-not
+ #'(lambda (frame) (eq frame (window-frame (minibuffer-window frame))))
+ (if device (device-frame-list device) (frame-list))))
;; XEmacs omission: Emacs has frames-on-display-list here, but that is
;; essentially equivalent to supplying the optional DEVICE argument to
＠＠ -1745,9 +1740,10 ＠＠
(or (plist-get default-frame-plist 'name)
default-frame-name))
(frames
- (sort (filtered-frame-list #'(lambda (x)
- (or (frame-visible-p x)
- (frame-iconified-p x))))
+ (sort (remove-if-not #'(lambda (x)
+ (or (frame-visible-p x)
+ (frame-iconified-p x)))
+ (frame-list))
#'(lambda (s1 s2)
(cond ((and (frame-visible-p s1)
(not (frame-visible-p s2))))
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments