[COMMIT] (slightly revised) General X11 selection cleanup.
19 years, 7 months
Aidan Kehoe
Aidan Kehoe
NOTE: This patch has been committed.
SUPERSEDES 16928.62724.829178.430388(a)parhasard.net
Updated, based on feedback.
lisp/ChangeLog addition:
2005-02-28 Aidan Kehoe <kehoea(a)parhasard.net>
* select.el (selected-text-type): Removed.
* select.el (selection-preferred-types): New.
* select.el ('selected-text-type): New.
Rename selected-text-type to selection-preferred-types, now that
it's full of image types as fallbacks. Define an alias to the old
name.
* select.el (kill-primary-selection): deleted -> delete
* select.el (get-selection-no-error):
* select.el (get-selection):
* select.el (get-selection-foreign):
Reference selection-preferred-types instead of giving details of
which types these functions default to wanting.
* select.el (select-make-extent-for-selection): Comment that we
need to hook something similar into the rectangle functions.
* select.el (select-convert-in):
If we don't have a handler for an X11 selection, pass the value
itself as a string. Fixes X11 atoms.
* select.el (select-convert-to-timestamp): New.
Uses get-xemacs-selection-timestamp.
* select.el (select-convert-to-utf-8-text): New.
* select.el (select-convert-from-text): Removed.
The change in select-convert-in makes this irrelevant.
* select.el (select-convert-from-length): Removed.
We have a more generic integer conversion routine here.
* select.el (select-convert-from-filename): Removed.
The generic string conversion handles this.
* select.el (select-convert-from-ip-address): New.
Whee.
* select.el (select-convert-from-utf-8-text): New.
* select.el (select-convert-from-utf-16-le-text): New.
The various Mozilla-specific types need the utf-16 conversion;
utf-8 conversion is _in_ this season, didn't you know?
* select.el (select-convert-from-image-data): New.
Generic convert-an-image-to-a-space-with-end-glyph function. Used
by the next six functions.
* select.el (select-convert-from-image/gif): New.
* select.el (select-convert-from-image/jpeg): New.
* select.el (select-convert-from-image/png): New.
* select.el (select-convert-from-image/tiff): New.
* select.el (select-convert-from-image/xpm): New.
* select.el (select-convert-from-image/xbm): New.
Check if we have support for a given image format; if so, pass
back a space with the corresponding selection's image attached as
glyph data.
* select.el (select-convert-from-cf-unicodetext):
* select.el (select-convert-to-cf-text):
* select.el (select-convert-to-cf-unicodetext):
Check that the corresponding Windows coding systems are available
before trying to convert.
* select.el (selection-converter-out-alist):
* select.el (selection-converter-in-alist):
Update both lists to reflect the other changes in the file.
* x-select.el (x-selected-text-type):
Update the define-obsolete-variable-alias now selected-text-type
is called something else.
src/ChangeLog addition:
2005-02-28 Aidan Kehoe <kehoea(a)parhasard.net>
* select-gtk.c (emacs_gtk_selection_handle):
* select-gtk.c (emacs_gtk_selection_clear_event_handle):
Use get_selection_raw_timestamp instead of Fget_selection_timestamp.
* select-gtk.c (gtk_own_selection):
Cross reference to some debate in select-x.c
* select-x.c:
* select-x.c (x_handle_selection_request):
Discuss Time vs. time_t--I think Time is _always_ thirty-two-bit
and time_t is variable in size.
* select-x.c (x_handle_selection_clear):
Replace call to Fget_selection_timestamp with call to
get_selection_raw_time, check that pasted data pointer is non-zero
before trying to free it.
* select.c:
* select.c (Fown_selection_internal):
Informative comment! Shouldn't actually be needed outside of the X
world.
* select.c (get_selection_raw_time): New function.
* select.c (Fget_selection_timestamp): Rework to use
get_selection_raw_time.
* select.h:
Make get_selection_raw_time available.
XEmacs Trunk (existing ChangeLogs) source patch:
Diff command: cvs -q diff -u
Files affected: src/select.h src/select.c src/select-x.c src/select-gtk.c lisp/x-select.el lisp/select.el
Index: lisp/select.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/select.el,v
retrieving revision 1.13
diff -u -u -r1.13 select.el
--- lisp/select.el 2002/05/23 11:46:10 1.13
+++ lisp/select.el 2005/02/28 20:12:08
＠＠ -33,13 +33,25 ＠＠
;;; Code:
-(defvar selected-text-type
- (if (featurep 'mule) '(COMPOUND_TEXT STRING) 'STRING)
- "The type atom used to obtain selections from the X server.
-Can be either a valid X selection data type, or a list of such types.
-COMPOUND_TEXT and STRING are the most commonly used data types.
-If a list is provided, the types are tried in sequence until
-there is a successful conversion.")
+;; We prefer UTF8_STRING to COMPOUND_TEXT because, even though the latter
+;; gives us more information when taking data from other XEmacs invocations,
+;; Mozilla will happily give us broken COMPOUND_TEXT where a non-broken
+;; UTF8_STRING is available.
+(defvar selection-preferred-types
+ (let ((res '(UTF8_STRING COMPOUND_TEXT STRING image/png image/gif
+ image/jpeg image/tiff image/xpm image/xbm)))
+ (unless (featurep 'mule) (delq 'COMPOUND_TEXT res))
+ res)
+ "An ordered list of X11 type atoms for selections we want to receive.
+We prefer UTF8_STRING over COMPOUND_TEXT, for compatibility with a certain
+widely-used browser suite, and COMPOUND_TEXT over STRING. (COMPOUND_TEXT
+isn't available on non-Mule.) We also accept several image types.
+
+For compatibility, this can be a single atom. ")
+
+;; Renamed because it was just ridiculous for it to be mostly image formats
+;; and named selected-text-type.
+(define-obsolete-variable-alias 'selected-text-type 'selection-preferred-types)
(defvar selection-sets-clipboard nil
"Controls the selection's relationship to the clipboard.
＠＠ -56,7 +68,7 ＠＠
(cut-copy-clear-internal 'copy)))
(defun kill-primary-selection ()
- "Copy the selection to the Clipboard and the kill ring, then deleted it.
+ "Copy the selection to the Clipboard and the kill ring, then delete it.
This is similar to the command \\[kill-region] except that it will
save to the Clipboard even if that command doesn't, and it handles rectangles
properly."
＠＠ -97,34 +109,56 ＠＠
(defun get-selection-no-error (&optional type data-type)
"Return the value of a window-system selection.
-The argument TYPE (default `PRIMARY') says which selection,
-and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule)
-says how to convert the data. Returns NIL if there is no selection."
+The argument TYPE (default `PRIMARY') says which selection, and the argument
+DATA-TYPE (defaulting to the value of `selection-preferred-types'), says how
+to convert the data. Returns NIL if there is no selection."
(condition-case nil (get-selection type data-type) (t nil)))
(defun get-selection (&optional type data-type)
"Return the value of a window-system selection.
-The argument TYPE (default `PRIMARY') says which selection,
-and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule)
-says how to convert the data. If there is no selection an error is signalled.
-Not suitable in a `interprogram-paste-function', q.v."
+The argument TYPE (default `PRIMARY') says which selection, and the argument
+DATA-TYPE (defaulting to the value of, and compatible with,
+`selection-preferred-types') says how to convert the data. If
+there is no selection an error is signalled. Not suitable in a
+`interprogram-paste-function', q.v."
(or type (setq type 'PRIMARY))
- (or data-type (setq data-type selected-text-type))
+ (or data-type (setq data-type selection-preferred-types))
(if (consp data-type)
- (condition-case err
- (get-selection-internal type (car data-type))
- (selection-conversion-error
- (if (cdr data-type)
- (get-selection type (cdr data-type))
- (signal (car err) (cdr err)))))
+ ;; TARGETS is a vector; we want a list so we can memq --> append it to
+ ;; nil.
+ (let ((targets (append (get-selection-internal type 'TARGETS) nil))
+ res)
+ (catch 'converted
+ (if targets
+ (dolist (current-preference data-type)
+ (condition-case err
+ (if (and (memq current-preference targets)
+ (setq res (get-selection-internal
+ type current-preference)))
+ (throw 'converted res))
+ (selection-conversion-error
+ nil))))
+ ;; The source app didn't offer us anything compatible in TARGETS,
+ ;; or they're not negotiating at all. (That is, we're probably not
+ ;; on X11.) Try to convert to the types specified by our caller,
+ ;; and throw an error if the last one of those fails.
+ (while data-type
+ (condition-case err
+ (progn
+ (setq res (get-selection-internal type (car data-type)))
+ (throw 'converted res))
+ (selection-conversion-error
+ (if (cdr data-type)
+ (setq data-type (pop data-type))
+ (signal (car err) (cdr err))))))))
(get-selection-internal type data-type)))
(defun get-selection-foreign (&optional type data-type)
"Return the value of a window-system selection, or nil if XEmacs owns it.
-The argument TYPE (default `PRIMARY') says which selection,
-and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule)
-says how to convert the data. If there is no selection an error is signalled.
-See `interprogram-paste-function' for more information."
+The argument TYPE (default `PRIMARY') says which selection, and the argument
+DATA-TYPE (defaulting to the value of `selection-preferred-types' which see)
+says how to convert the data. If there is no selection an error is
+signalled. See `interprogram-paste-function' for more information."
(unless (selection-owner-p type)
(get-selection type data-type)))
＠＠ -255,6 +289,8 ＠＠
;; Given a selection, this makes an extent in the buffer which holds that
;; selection, for highlighting purposes. If the selection isn't associated
;; with a buffer, this does nothing.
+ ;;
+ ;; Something similar needs to be hooked into the rectangle functions.
(let ((buffer nil)
(valid (and (extentp previous-extent)
(extent-object previous-extent)
＠＠ -391,8 +427,9 ＠＠
suitable internal representation otherwise."
(when value
(let ((handler-fn (cdr (assq type selection-converter-in-alist))))
- (when handler-fn
- (apply handler-fn (list selection type value))))))
+ (if handler-fn
+ (apply handler-fn (list selection type value))
+ value))))
(defun select-convert-out (selection type value)
"Attempt to convert the specified internal VALUE for the specified DATA-TYPE
＠＠ -439,13 +476,42 ＠＠
(buffer-substring (car value) (cdr value)))))
(t nil)))
+(defun select-convert-to-timestamp (selection type value)
+ (let ((ts (get-xemacs-selection-timestamp selection)))
+ (if ts (cons 'TIMESTAMP ts))))
+
+(defun select-convert-to-utf-8-text (selection type value)
+ (cond ((stringp value)
+ (cons 'UTF8_STRING (encode-coding-string value 'utf-8)))
+ ((extentp value)
+ (save-excursion
+ (set-buffer (extent-object value))
+ (save-restriction
+ (widen)
+ (cons 'UTF8_STRING
+ (encode-coding-string
+ (buffer-substring (extent-start-position value)
+ (extent-end-position value)) 'utf-8)))))
+ ((and (consp value)
+ (markerp (car value))
+ (markerp (cdr value)))
+ (or (eq (marker-buffer (car value)) (marker-buffer (cdr value)))
+ (signal 'error
+ (list "markers must be in the same buffer"
+ (car value) (cdr value))))
+ (save-excursion
+ (set-buffer (or (marker-buffer (car value))
+ (error "selection is in a killed buffer")))
+ (save-restriction
+ (widen)
+ (cons 'UTF8_STRING (encode-coding-string
+ (buffer-substring (car value) (cdr value))
+ 'utf-8)))))
+ (t nil)))
+
(defun select-coerce-to-text (selection type value)
(select-convert-to-text selection type value))
-(defun select-convert-from-text (selection type value)
- (when (stringp value)
- value))
-
(defun select-convert-to-string (selection type value)
(let ((outval (select-convert-to-text selection type value)))
;; force the string to be not in Compound Text format. This grubby
＠＠ -477,9 +543,6 ＠＠
(cons (ash value -16) (logand value 65535))
nil)))
-(defun select-convert-from-length (selection type value)
- (select-convert-to-length selection type value))
-
(defun select-convert-to-targets (selection type value)
;; return a vector of atoms, but remove duplicates first.
(let* ((all (cons 'TIMESTAMP (mapcar 'car selection-converter-alist)))
＠＠ -509,10 +572,6 ＠＠
(error "selection is in a killed buffer"))))
(t nil)))
-(defun select-convert-from-filename (selection type value)
- (when (stringp value)
- value))
-
(defun select-convert-to-charpos (selection type value)
(let (a b tmp)
(cond ((cond ((extentp value)
＠＠ -682,35 +741,89 ＠＠
(t nil)
))
+(defun select-convert-from-ip-address (selection type value)
+ (if (and (stringp value)
+ (= (length value) 4))
+ (format "%d.%d.%d.%d"
+ (aref value 0) (aref value 1) (aref value 2) (aref value 3))))
+
(defun select-convert-to-atom (selection type value)
(and (symbolp value) value))
+(defun select-convert-from-utf-8-text (selection type value)
+ (decode-coding-string value 'utf-8))
+
+(defun select-convert-from-utf-16-le-text (selection type value)
+ (decode-coding-string value 'utf-16-le))
+
+;; Image conversion.
+(defun select-convert-from-image-data (image-type value)
+ "Take an image type specification--one of the image types this XEmacs
+supports--and some data in that format, return a space, with a glyph
+corresponding to that data as an end-glyph extent property of that space. "
+ (let* ((str (make-string 1 ?\ ))
+ (extent (make-extent 0 1 str))
+ (glyph (make-glyph (vector image-type ':data value))))
+ (when glyph
+ (set-extent-property extent 'invisible t)
+ (set-extent-property extent 'start-open t)
+ (set-extent-property extent 'end-open t)
+ (set-extent-property extent 'duplicable t)
+ (set-extent-property extent 'atomic t)
+ (set-extent-end-glyph extent glyph)
+ str)))
+
+;; Could automate defining these functions these with a macro, but damned if
+;; I can get that to work. Anyway, this is more readable.
+
+(defun select-convert-from-image/gif (selection type value)
+ (if (featurep 'gif) (select-convert-from-image-data 'gif value)))
+
+(defun select-convert-from-image/jpeg (selection type value)
+ (if (featurep 'jpeg) (select-convert-from-image-data 'jpeg value)))
+
+(defun select-convert-from-image/png (selection type value)
+ (if (featurep 'png) (select-convert-from-image-data 'png value)))
+
+(defun select-convert-from-image/tiff (selection type value)
+ (if (featurep 'tiff) (select-convert-from-image-data 'tiff value)))
+
+(defun select-convert-from-image/xpm (selection type value)
+ (if (featurep 'xpm) (select-convert-from-image-data 'xpm value)))
+
+(defun select-convert-from-image/xbm (selection type value)
+ (if (featurep 'xbm) (select-convert-from-image-data 'xbm value)))
+
;;; CF_xxx conversions
(defun select-convert-from-cf-text (selection type value)
- (let ((value (decode-coding-string value 'mswindows-multibyte)))
- (replace-in-string (if (string-match "\0" value)
- (substring value 0 (match-beginning 0))
- value)
- "\\(\r\n\\|\n\r\\)" "\n" t)))
+ (if (find-coding-system 'mswindows-multibyte)
+ (let ((value (decode-coding-string value 'mswindows-multibyte)))
+ (replace-in-string (if (string-match "\0" value)
+ (substring value 0 (match-beginning 0))
+ value)
+ "\\(\r\n\\|\n\r\\)" "\n" t))))
(defun select-convert-from-cf-unicodetext (selection type value)
- (let ((value (decode-coding-string value 'mswindows-unicode)))
- (replace-in-string (if (string-match "\0" value)
- (substring value 0 (match-beginning 0))
- value)
- "\\(\r\n\\|\n\r\\)" "\n" t)))
+ (if (find-coding-system 'mswindows-unicode)
+ (let ((value (decode-coding-string value 'mswindows-unicode)))
+ (replace-in-string (if (string-match "\0" value)
+ (substring value 0 (match-beginning 0))
+ value)
+ "\\(\r\n\\|\n\r\\)" "\n" t))))
(defun select-convert-to-cf-text (selection type value)
- (let ((text (select-convert-to-text selection type value)))
- (encode-coding-string
- (concat (replace-in-string text "\n" "\r\n" t) "\0")
- 'mswindows-multibyte)))
+ (if (find-coding-system 'mswindows-multibyte)
+ (let ((text (select-convert-to-text selection type value)))
+ (encode-coding-string
+ (concat (replace-in-string text "\n" "\r\n" t) "\0")
+ 'mswindows-multibyte))))
(defun select-convert-to-cf-unicodetext (selection type value)
- (let ((text (select-convert-to-text selection type value)))
- (encode-coding-string
- (concat (replace-in-string text "\n" "\r\n" t) "\0")
- 'mswindows-unicode)))
+ (if (find-coding-system 'mswindows-unicode)
+ (let ((text (select-convert-to-text selection type value)))
+ (encode-coding-string
+ (concat (replace-in-string text "\n" "\r\n" t) "\0")
+ 'mswindows-unicode))))
;;; Appenders
(defun select-append-to-text (selection type value1 value2)
＠＠ -788,7 +901,9 ＠＠
;; Types listed in here can be selections of XEmacs
(setq selection-converter-out-alist
- '((TEXT . select-convert-to-text)
+ '((TIMESTAMP . select-convert-to-timestamp)
+ (UTF8_STRING . select-convert-to-utf-8-text)
+ (TEXT . select-convert-to-text)
(STRING . select-convert-to-string)
(COMPOUND_TEXT . select-convert-to-compound-text)
(TARGETS . select-convert-to-targets)
＠＠ -813,21 +928,28 ＠＠
;; Types listed here can be selections foreign to XEmacs
(setq selection-converter-in-alist
'(; Specific types that get handled by generic converters
- (COMPOUND_TEXT . select-convert-from-text)
- (SOURCE_LOC . select-convert-from-text)
- (OWNER_OS . select-convert-from-text)
- (HOST_NAME . select-convert-from-text)
- (USER . select-convert-from-text)
- (CLASS . select-convert-from-text)
- (NAME . select-convert-from-text)
- ; Generic types
(INTEGER . select-convert-from-integer)
- (TEXT . select-convert-from-text)
- (STRING . select-convert-from-text)
- (LENGTH . select-convert-from-length)
- (FILE_NAME . select-convert-from-filename)
+ (TIMESTAMP . select-convert-from-integer)
+ (LENGTH . select-convert-from-integer)
+ (LIST_LENGTH . select-convert-from-integer)
+ (CLIENT_WINDOW . select-convert-from-integer)
+ (PROCESS . select-convert-from-integer)
+ (IP_ADDRESS . select-convert-from-ip-address)
+ ;; We go after UTF8_STRING in preference to STRING because Mozilla,
+ ;; at least, does bad things with non-Latin-1 Unicode characters in
+ ;; STRING.
+ (UTF8_STRING . select-convert-from-utf-8-text)
(CF_TEXT . select-convert-from-cf-text)
(CF_UNICODETEXT . select-convert-from-cf-unicodetext)
+ (text/html . select-convert-from-utf-16-le-text) ; Mozilla
+ (text/_moz_htmlcontext . select-convert-from-utf-16-le-text)
+ (text/_moz_htmlinfo . select-convert-from-utf-16-le-text)
+ (image/png . select-convert-from-image/png)
+ (image/gif . select-convert-from-image/gif)
+ (image/jpeg . select-convert-from-image/jpeg )
+ (image/tiff . select-convert-from-image/tiff )
+ (image/xpm . select-convert-from-image/xpm)
+ (image/xbm . select-convert-from-image/xbm)
))
;; Types listed here have special coercion functions that can munge
Index: lisp/x-select.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-select.el,v
retrieving revision 1.7
diff -u -u -r1.7 x-select.el
--- lisp/x-select.el 2001/05/04 22:42:18 1.7
+++ lisp/x-select.el 2005/02/28 20:12:09
＠＠ -43,7 +43,7 ＠＠
(define-obsolete-function-alias 'x-selection-owner-p 'selection-owner-p)
(define-obsolete-variable-alias 'x-selection-converter-alist 'selection-converter-alist)
(define-obsolete-variable-alias 'x-lost-selection-hooks 'lost-selection-hooks)
-(define-obsolete-variable-alias 'x-selected-text-type 'selected-text-type)
+(define-obsolete-variable-alias 'x-selected-text-type 'selection-preferred-types)
(define-obsolete-function-alias 'x-valid-simple-selection-p 'valid-simple-selection-p)
(define-obsolete-function-alias 'x-own-selection 'own-selection)
(define-obsolete-function-alias 'x-disown-selection 'disown-selection)
Index: src/select-gtk.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/select-gtk.c,v
retrieving revision 1.16
diff -u -u -r1.16 select-gtk.c
--- src/select-gtk.c 2004/11/04 23:06:52 1.16
+++ src/select-gtk.c 2005/02/28 20:12:38
＠＠ -158,7 +158,7 ＠＠
target_symbol = fetch_multiple_target (selection_data);
#endif
- temp_obj = Fget_selection_timestamp (selection_symbol);
+ temp_obj = get_selection_raw_time(selection_symbol);
if (NILP (temp_obj))
{
＠＠ -255,7 +255,7 ＠＠
selection_symbol = atom_to_symbol (d, selection);
- local_selection_time_lisp = Fget_selection_timestamp (selection_symbol);
+ local_selection_time_lisp = get_selection_raw_time (selection_symbol);
/* We don't own the selection, so that's fine. */
if (NILP (local_selection_time_lisp))
＠＠ -428,13 +428,14 ＠＠
selection_atom,
thyme);
- /* We do NOT use time_to_lisp() here any more, like we used to.
+ /* [[ We do NOT use time_to_lisp() here any more, like we used to.
That assumed equivalence of time_t and Time, which is not
necessarily the case (e.g. under OSF on the Alphas, where
Time is a 64-bit quantity and time_t is a 32-bit quantity).
- Opaque pointers are the clean way to go here.
- */
+ Opaque pointers are the clean way to go here. ]]
+
+ See my comment on the same issue in select-x.c -- Aidan. */
return make_opaque (&thyme, sizeof (thyme));
}
Index: src/select-x.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/select-x.c,v
retrieving revision 1.18
diff -u -u -r1.18 select-x.c
--- src/select-x.c 2005/02/28 17:02:10 1.18
+++ src/select-x.c 2005/02/28 20:12:38
＠＠ -237,13 +237,21 ＠＠
XSetSelectionOwner (display, selection_atom, selecting_window, thyme);
- /* We do NOT use time_to_lisp() here any more, like we used to.
+ /* [[ We do NOT use time_to_lisp() here any more, like we used to.
That assumed equivalence of time_t and Time, which is not
necessarily the case (e.g. under OSF on the Alphas, where
- Time is a 64-bit quantity and time_t is a 32-bit quantity).
+ Time is a 64-bit quantity and time_t is a 32-bit quantity).]]
- Opaque pointers are the clean way to go here.
- */
+ This is wrong--on Digital Unix, time_t is a sixty-four-bit quantity,
+ and Time is, as the X protocol dictates, a thirty-two-bit quantity.
+
+ [[ Opaque pointers are the clean way to go here. ]]
+
+ Again, I disagree--the Lisp selection infrastructure needs to be
+ able to manipulate the selection timestamps if it is, as we want
+ it to, to be able to do most of the work. Though I have moved the
+ conversion to lisp to get-xemacs-selection-timestamp. -- Aidan. */
+
selection_time = make_opaque (&thyme, sizeof (thyme));
#ifdef MOTIF_CLIPBOARDS
＠＠ -617,7 +625,7 ＠＠
target_symbol = fetch_multiple_target (event);
#endif
- temp_obj = Fget_selection_timestamp (selection_symbol);
+ temp_obj = get_selection_raw_time (selection_symbol);
if (NILP (temp_obj))
{
＠＠ -665,7 +673,12 ＠＠
successful_p = Qt;
/* Tell x_selection_request_lisp_error() it's cool. */
event->type = 0;
- xfree (data, Rawbyte *);
+ /* Data need not have been allocated; cf. select-convert-to-delete in
+ lisp/select.el . */
+ if ((Rawbyte *)0 != data)
+ {
+ xfree (data, Rawbyte *);
+ }
}
unbind_to (count);
＠＠ -705,7 +718,7 ＠＠
selection_symbol = x_atom_to_symbol (d, selection);
- local_selection_time_lisp = Fget_selection_timestamp (selection_symbol);
+ local_selection_time_lisp = get_selection_raw_time (selection_symbol);
/* We don't own the selection, so that's fine. */
if (NILP (local_selection_time_lisp))
Index: src/select.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/select.c,v
retrieving revision 1.6
diff -u -u -r1.6 select.c
--- src/select.c 2002/06/20 21:18:45 1.6
+++ src/select.c 2005/02/28 20:12:39
＠＠ -289,6 +289,14 ＠＠
/* have to do device specific stuff last so that methods can access the
selection_alist */
+
+ /* If you are re-implementing this for another redisplay type, either make
+ certain that the selection time will fit within thirty-two bits, or
+ redesign get-xemacs-selection-timestamp to return, say, a bignum, and
+ convert the device-specific timestamp to a bignum before storing it in
+ this list. The current practice is to blindly assume that the timestamp
+ is thirty-two bits, which will work for extant architectures. */
+
if (HAS_DEVMETH_P (XDEVICE (device), own_selection))
selection_time = DEVMETH (XDEVICE (device), own_selection,
(selection_name, selection_value,
＠＠ -492,18 +500,36 ＠＠
: Qnil;
}
+Lisp_Object
+get_selection_raw_time(Lisp_Object selection)
+{
+ Lisp_Object local_value = assq_no_quit (selection, Vselection_alist);
+
+ if (!NILP (local_value))
+ {
+ return XCAR (XCDR (XCDR (local_value)));
+ }
+ return Qnil;
+}
+
/* Get the timestamp of the given selection */
-DEFUN ("get-selection-timestamp", Fget_selection_timestamp, 1, 1, 0, /*
-Return the timestamp associated with the specified SELECTION, if it exists.
-Note that the timestamp is a device-specific object, and may not actually be
-visible from Lisp.
+DEFUN ("get-xemacs-selection-timestamp", Fget_selection_timestamp, 1, 1, 0, /*
+Return timestamp for SELECTION, if belongs to XEmacs and exists.
+
+The timestamp is a cons of two integers, the first being the higher-order
+sixteen bits of the device-specific thirty-two-bit quantity, the second
+being the lower-order sixteen bits of same. Expect to see this API change
+when and if redisplay on a window system with timestamps wider than 32bits
+happens.
*/
(selection))
{
- Lisp_Object local_value = assq_no_quit (selection, Vselection_alist);
+ Lisp_Object val = get_selection_raw_time(selection);
- if (!NILP (local_value))
- return XCAR (XCDR (XCDR (local_value)));
+ if (!NILP (val))
+ {
+ return word_to_lisp(* (UINT_32_BIT *) XOPAQUE_DATA (val));
+ }
return Qnil;
}
Index: src/select.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/select.h,v
retrieving revision 1.2
diff -u -u -r1.2 select.h
--- src/select.h 2001/04/12 18:24:19 1.2
+++ src/select.h 2005/02/28 20:12:39
＠＠ -57,12 +57,13 ＠＠
void select_notify_buffer_kill (Lisp_Object buffer);
+Lisp_Object get_selection_raw_time(Lisp_Object selection);
+
/* Lisp functions we export for other files' use */
EXFUN (Fregister_selection_data_type, 2);
EXFUN (Fselection_data_type_name, 2);
EXFUN (Favailable_selection_types, 2);
EXFUN (Fselection_owner_p, 1);
EXFUN (Fselection_exists_p, 3);
-EXFUN (Fget_selection_timestamp, 1);
#endif /* INCLUDED_select_h_ */
--
“I, for instance, am gung-ho about open source because my family is being
held hostage in Rob Malda’s basement. But who fact-checks me, or Enderle,
when we say something in public? No-one!” -- Danny O’Brien
- 1 participants
- 0 comments
[PATCH] (Revised) Incremental selection transfer fix.
19 years, 7 months
Aidan Kehoe
Aidan Kehoe
SUPERSEDES 16927.42810.718759.62839(a)parhasard.net
Those of you paying attention to my last patch will, of course, have noticed
that it breaks if XEmacs’ currently selected frame has no relation to the
X11 display on which the selection request is taking place. This fixes that;
unfortunately, the 21.4 patch diverges here, the new widget initialisation
being;
Widget widget = FRAME_X_TEXT_WIDGET(XFRAME(DEVICE_SELECTED_FRAME(d)));
I’ll send a full patch for that if it’s wanted.
src/ChangeLog addition:
2005-02-26 Aidan Kehoe <kehoea(a)parhasard.net>
* select-x.c (x_reply_selection_request): Use XtRegisterDrawable
to tell Xt not to drop PropertyChange events destined for the
selection request target window. This makes incremental selection
transfer work, instead of looping until interrupted.
XEmacs Trunk source patch:
Diff command: cvs -q diff -u
Files affected: src/select-x.c
Index: src/select-x.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/select-x.c,v
retrieving revision 1.17
diff -u -u -r1.17 select-x.c
--- src/select-x.c 2005/01/24 23:34:09 1.17
+++ src/select-x.c 2005/02/26 04:18:50
＠＠ -521,12 +521,22 ＠＠
{
/* Send an INCR selection. */
int prop_id;
+ Widget widget = FRAME_X_TEXT_WIDGET (DEVICE_SELECTED_FRAME(d));
if (x_window_to_frame (d, window)) /* #### debug */
- invalid_operation ("attempt to transfer an INCR to ourself!", Qunbound);
+ invalid_operation ("attempt to transfer an INCR to ourself!",
+ Qunbound);
#if 0
stderr_out ("\nINCR %d\n", bytes_remaining);
#endif
+
+ /* Tell Xt not to drop PropertyNotify events that arrive for the
+ target window, rather, pass them to us. This would be a hack, but
+ the Xt selection routines are broken for our purposes--we can't
+ pass them callbacks from Lisp, for example. Let's call it a
+ workaround. */
+ XtRegisterDrawable(display, (Drawable)window, widget);
+
prop_id = expect_property_change (display, window, reply.property,
PropertyDelete);
＠＠ -570,8 +580,10 ＠＠
stderr_out (" INCR done\n");
#endif
if (! waiting_for_other_props_on_window (display, window))
+ {
XSelectInput (display, window, 0L);
-
+ XtUnregisterDrawable(display, (Drawable)window);
+ }
XChangeProperty (display, window, reply.property, type, format,
PropModeReplace, data, 0);
}
--
“I, for instance, am gung-ho about open source because my family is being
held hostage in Rob Malda’s basement. But who fact-checks me, or Enderle,
when we say something in public? No-one!” -- Danny O’Brien
- 1 participants
- 1 comments
[AC web] update web site for new and returned reviewers
19 years, 7 months
Stephen J. Turnbull
Stephen J. Turnbull
APPROVE COMMIT web
Index: Develop/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacsweb/Develop/ChangeLog,v
retrieving revision 1.96
diff -u -r1.96 ChangeLog
--- Develop/ChangeLog 17 Feb 2005 08:34:59 -0000 1.96
+++ Develop/ChangeLog 28 Feb 2005 12:21:21 -0000
＠＠ -0,0 +1,5 ＠＠
+2005-02-28 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * jobs.content: Add Aidan Kehoe and Steve Youngs to reviewers.
+ Reactivate Hrvoje. Jason Mastaler is long gone.
+
Index: People/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacsweb/People/ChangeLog,v
retrieving revision 1.3
diff -u -r1.3 ChangeLog
--- People/ChangeLog 31 Jan 2005 20:31:27 -0000 1.3
+++ People/ChangeLog 28 Feb 2005 12:21:22 -0000
＠＠ -0,0 +1,7 ＠＠
+2005-02-28 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * .htaccess: Add rewrite rule youngs->steve.youngs.
+
+ * steve.youngs/index.content: Revise Steve's page to be a little
+ more appropriate for a reviewer.
+
Index: Develop/jobs.content
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacsweb/Develop/jobs.content,v
retrieving revision 1.30
diff -u -r1.30 jobs.content
--- Develop/jobs.content 31 Jan 2005 20:52:46 -0000 1.30
+++ Develop/jobs.content 28 Feb 2005 12:21:21 -0000
＠＠ -30,18 +30,20 ＠＠
<ul>
<li><a href="../People/adrian">Adrian Aichner</a></li>
+ <li><a href="../People/aidan">Aidan Kehoe</a></li>
<li><a href="../People/andy">Andy Piper</a></li>
<li><a href="../People/ben">Ben Wing</a></li>
<li><a href="../People/didier">Didier Verna</a></li>
+ <li><a href="../People/hrvoje">Hrvoje Niksic</a></li>
<li><a href="../People/james">Jerry James</a></li>
<li><a href="../People/malcolmp">Malcolm Purvis</a></li>
<li><a href="../People/mike">Michael Sperber</a></li>
<li><a href="../People/viteno">Norbert Koch</a></li>
<li><a href="../People/stephen">Stephen Turnbull</a></li>
+ <li><a href="../People/youngs">Steve Youngs</a></li>
<li><a href="../People/scop">Ville Skyttä</a></li>
<li><a href="../People/acs">Vin Shelton</a></li>
<li><a href="../People/gunnar">Gunnar Evermann (<em>inactive</em>)</a></li>
- <li><a href="../People/hrvoje">Hrvoje Niksic (<em>inactive</em>)</a></li>
<li><a href="../People/jan">Jan Vroonhof (<em>inactive</em>)</a></li>
<li><a href="../People/jareth">Jareth Hein (<em>inactive</em>)</a></li>
<li><a href="../People/jonathan">Jonathan Harris (<em>inactive</em>)</a></li>
＠＠ -224,7 +226,6 ＠＠
<ul>
<!-- one of (dd dt) -->
<li><a href="../People/fabrice">Fabrice Popineau</a></li>
- <li><a href="../People/jason">Jason Mastaler (<em>inactive</em>)</a></li>
</ul>
</td>
</tr>
Index: People/.htaccess
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacsweb/People/.htaccess,v
retrieving revision 1.5
diff -u -r1.5 .htaccess
--- People/.htaccess 31 Jan 2005 03:20:23 -0000 1.5
+++ People/.htaccess 28 Feb 2005 12:21:22 -0000
＠＠ -153,3 +153,4 ＠＠
RewriteRule ^bill\.perry(/.*)?$ william.perry$1 [L]
RewriteRule ^hayashi(/.*)?$ yoshiki.hayashi$1 [L]
RewriteRule ^yoshiki(/.*)?$ yoshiki.hayashi$1 [L]
+RewriteRule ^youngs(/.*)?$ steve.youngs$1 [L]
Index: People/steve.youngs/index.content
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacsweb/People/steve.youngs/index.content,v
retrieving revision 1.1
diff -u -r1.1 index.content
--- People/steve.youngs/index.content 31 Jan 2005 02:58:02 -0000 1.1
+++ People/steve.youngs/index.content 28 Feb 2005 12:21:22 -0000
＠＠ -10,9 +10,10 ＠＠
This is the XEmacs home page for Steve Youngs, one of the developers of
XEmacs.</p>
- <p>Steve has voluntarily exiled himself from the XEmacs community in
- order to create the forked project <a
- href="http://www.sxemacs.org/">SXEmacs</a>. He can be reached at <a
+ <p>Steve is currently concentrating on a new fork of XEmacs <a
+ href="http://www.sxemacs.org/">SXEmacs</a>, but is lending his
+ strength to the XEmacs Project where the code is still developed
+ in common (which is almost all of it). He can be reached at <a
href="mailto:steve＠sxemacs.org"><steve＠sxemacs.org></a>.
</p>
--
Institute of Policy and Planning Sciences http://turnbull.sk.tsukuba.ac.jp
University of Tsukuba Tennodai 1-1-1 Tsukuba 305-8573 JAPAN
Ask not how you can "do" free software business;
ask what your business can "do for" free software.
- 1 participants
- 0 comments
[PATCH] xemacs-21.5-clean: show-memory-usage to sort sections by total usage
19 years, 7 months
Adrian Aichner
Adrian Aichner
The first thing I always do on output of
M-x show-memory-usage
is to sort each section numerically by the last (total usage) column.
This got tiring, hence I created this somewhat ugly patch.
I am editing the output after the fact since the current design prints
each object in the order returned by memfun.
I'll wait for approval or supersession of this patch by Ben before I
commit.
Best regards,
Adrian
xemacs-21.5-clean ChangeLog patch:
Diff command: cvs -q diff -U 0
Files affected: lisp/ChangeLog
Index: lisp/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v
retrieving revision 1.646
diff -u -U0 -r1.646 ChangeLog
--- lisp/ChangeLog 23 Feb 2005 22:25:15 -0000 1.646
+++ lisp/ChangeLog 25 Feb 2005 00:10:59 -0000
＠＠ -0,0 +1,5 ＠＠
+2005-02-25 Adrian Aichner <adrian(a)xemacs.org>
+
+ * diagnose.el: Fix typo.
+ * diagnose.el (show-memory-usage): Sort sections by total usage.
+
xemacs-21.5-clean source patch:
Diff command: cvs -f -z3 -q diff -u -w -N
Files affected: lisp/diagnose.el
Index: lisp/diagnose.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/diagnose.el,v
retrieving revision 1.1
diff -u -w -r1.1 diagnose.el
--- lisp/diagnose.el 20 Mar 2002 10:20:50 -0000 1.1
+++ lisp/diagnose.el 25 Feb 2005 00:08:42 -0000
＠＠ -1,4 +1,4 ＠＠
-;;; debug.el --- routines for debugging problems in XEmacs
+;;; diagnose.el --- routines for debugging problems in XEmacs
;; Copyright (C) 2002 Ben Wing.
＠＠ -62,7 +62,7 ＠＠
(incf linelen fieldlen)
(format "%%%ds" fieldlen)))
types "")
- (progn (incf linelen 8) "%8s\n")))
+ (progn (incf linelen 9) "%9s\n")))
(princ "\n")
(princ (apply 'format fmt objtypename
(append types (list 'total))))
＠＠ -85,24 +85,56 ＠＠
(list totaltotal))))
totaltotal)))
- (let ((grandtotal 0))
- (with-output-to-temp-buffer "*memory usage*"
+ (let ((grandtotal 0)
+ (buffer "*memory usage*")
+ begin)
+ (with-output-to-temp-buffer buffer
+ (save-excursion
+ (set-buffer buffer)
(when-fboundp 'charset-list
+ (setq begin (point))
(incf grandtotal
(show-foo-stats 'charset (charset-list)
#'charset-memory-usage))
+ (sort-numeric-fields -1
+ (save-excursion
+ (goto-char begin)
+ (forward-line 2)
+ (point))
+ (save-excursion
+ (forward-line -2)
+ (point)))
(princ "\n"))
+ (setq begin (point))
(incf grandtotal
(show-foo-stats 'buffer (buffer-list) #'buffer-memory-usage))
+ (sort-numeric-fields -1
+ (save-excursion
+ (goto-char begin)
+ (forward-line 3)
+ (point))
+ (save-excursion
+ (forward-line -2)
+ (point)))
(princ "\n")
+ (setq begin (point))
(incf grandtotal
(show-foo-stats 'window (mapcan #'(lambda (fr)
(window-list fr t))
(frame-list))
#'window-memory-usage))
+ (sort-numeric-fields -1
+ (save-excursion
+ (goto-char begin)
+ (forward-line 3)
+ (point))
+ (save-excursion
+ (forward-line -2)
+ (point)))
(princ "\n")
(let ((total 0)
(fmt "%-30s%10s\n"))
+ (setq begin (point))
(princ (format fmt "object" "storage"))
(princ (make-string 40 ?-))
(princ "\n")
＠＠ -120,6 +152,14 ＠＠
(princ "\n")
(princ (format fmt "total" total))
(incf grandtotal total))
+ (sort-numeric-fields -1
+ (save-excursion
+ (goto-char begin)
+ (forward-line 2)
+ (point))
+ (save-excursion
+ (forward-line -2)
+ (point)))
- (princ (format "\n\ngrand total: %s\n" grandtotal))
+ (princ (format "\n\ngrand total: %s\n" grandtotal)))
grandtotal))))
--
Adrian Aichner
mailto:adrian＠xemacs.org
http://www.xemacs.org/
- 2 participants
- 3 comments
[C] xemacsweb: Long due fix of wilma configuration after list-archive move
19 years, 7 months
Adrian Aichner
Adrian Aichner
COMMIT
After fixing other mail archive releated breakage, like
(xemacweb＠gwyn) ~/list-archive $ find . -name .glimpse_filters -exec perl -p -i.orig -e 's,/web/http-xemacs/cgi-bin/wilma_striphtml,/web/http-xemacs/xemacsweb/cgi-bin/wilma_striphtml,' {} \;
and
(xemacweb＠gwyn) ~/list-archive $ find . -type d -a -name ".mhonarc.lck" -exec mv {} {}.orig \;
I finally found the root cause for failing matches in our mail
archives for articles younger than June 2004:
The webserver configuration was changed to serve files in the new
location and consequently the wilma configuration has to change as per
this patch.
I debugged this by turning on $DEBUG in wilma_glimpse.
Best regards,
Adrian
xemacsweb ChangeLog patch:
Diff command: cvs -q diff -U 0
Files affected: cgi-bin/.wilma/ChangeLog
Index: cgi-bin/.wilma/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacsweb/cgi-bin/.wilma/ChangeLog,v
retrieving revision 1.1
diff -u -U0 -r1.1 ChangeLog
--- cgi-bin/.wilma/ChangeLog 22 Jun 2004 21:14:05 -0000 1.1
+++ cgi-bin/.wilma/ChangeLog 27 Feb 2005 19:41:58 -0000
＠＠ -0,0 +1,18 ＠＠
+2005-02-27 Adrian Aichner <adrian(a)xemacs.org>
+
+ * xemacs-announce.cf: Long due fix of wilma configuration after
+ list-archive move.
+ * xemacs-beta-ja.cf: Ditto.
+ * xemacs-beta.cf: Ditto.
+ * xemacs-binary-kits.cf: Ditto.
+ * xemacs-build-reports.cf: Ditto.
+ * xemacs-cvs.cf: Ditto.
+ * xemacs-design.cf: Ditto.
+ * xemacs-mule.cf: Ditto.
+ * xemacs-nt.cf: Ditto.
+ * xemacs-patches.cf: Ditto.
+ * xemacs-review.cf: Ditto.
+ * xemacs-users-ja.cf: Ditto.
+ * xemacs-users-ru.cf: Ditto.
+ * xemacs.cf: Ditto.
+
xemacsweb source patch:
Diff command: cvs -f -z3 -q diff -u -w -N
Files affected: cgi-bin/.wilma/xemacs.cf cgi-bin/.wilma/xemacs-users-ru.cf cgi-bin/.wilma/xemacs-users-ja.cf cgi-bin/.wilma/xemacs-review.cf cgi-bin/.wilma/xemacs-patches.cf cgi-bin/.wilma/xemacs-nt.cf cgi-bin/.wilma/xemacs-mule.cf cgi-bin/.wilma/xemacs-design.cf cgi-bin/.wilma/xemacs-cvs.cf cgi-bin/.wilma/xemacs-build-reports.cf cgi-bin/.wilma/xemacs-binary-kits.cf cgi-bin/.wilma/xemacs-beta.cf cgi-bin/.wilma/xemacs-beta-ja.cf cgi-bin/.wilma/xemacs-announce.cf
Index: cgi-bin/.wilma/xemacs-announce.cf
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacsweb/cgi-bin/.wilma/xemacs-announce.cf,v
retrieving revision 1.1
diff -u -w -r1.1 xemacs-announce.cf
--- cgi-bin/.wilma/xemacs-announce.cf 18 Jul 2003 21:46:19 -0000 1.1
+++ cgi-bin/.wilma/xemacs-announce.cf 27 Feb 2005 19:31:09 -0000
＠＠ -19,7 +19,7 ＠＠
# directory itself).
#ARC_DIR = /path/to/your/$LIST.w3archive
-ARC_DIR = /web/http-xemacs/list-archive/$LIST
+ARC_DIR = /archives/http-xemacs/list-archive/$LIST
# [ wilma ]
# URL path of the HTML archive directories if different than the file
Index: cgi-bin/.wilma/xemacs-beta-ja.cf
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacsweb/cgi-bin/.wilma/xemacs-beta-ja.cf,v
retrieving revision 1.1
diff -u -w -r1.1 xemacs-beta-ja.cf
--- cgi-bin/.wilma/xemacs-beta-ja.cf 18 Jul 2003 21:46:19 -0000 1.1
+++ cgi-bin/.wilma/xemacs-beta-ja.cf 27 Feb 2005 19:31:09 -0000
＠＠ -19,7 +19,7 ＠＠
# directory itself).
#ARC_DIR = /path/to/your/$LIST.w3archive
-ARC_DIR = /web/http-xemacs/list-archive/$LIST
+ARC_DIR = /archives/http-xemacs/list-archive/$LIST
# [ wilma ]
# URL path of the HTML archive directories if different than the file
Index: cgi-bin/.wilma/xemacs-beta.cf
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacsweb/cgi-bin/.wilma/xemacs-beta.cf,v
retrieving revision 1.1
diff -u -w -r1.1 xemacs-beta.cf
--- cgi-bin/.wilma/xemacs-beta.cf 18 Jul 2003 21:46:19 -0000 1.1
+++ cgi-bin/.wilma/xemacs-beta.cf 27 Feb 2005 19:31:09 -0000
＠＠ -19,7 +19,7 ＠＠
# directory itself).
#ARC_DIR = /path/to/your/$LIST.w3archive
-ARC_DIR = /web/http-xemacs/list-archive/$LIST
+ARC_DIR = /archives/http-xemacs/list-archive/$LIST
# [ wilma ]
# URL path of the HTML archive directories if different than the file
Index: cgi-bin/.wilma/xemacs-binary-kits.cf
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacsweb/cgi-bin/.wilma/xemacs-binary-kits.cf,v
retrieving revision 1.1
diff -u -w -r1.1 xemacs-binary-kits.cf
--- cgi-bin/.wilma/xemacs-binary-kits.cf 18 Jul 2003 21:46:19 -0000 1.1
+++ cgi-bin/.wilma/xemacs-binary-kits.cf 27 Feb 2005 19:31:09 -0000
＠＠ -19,7 +19,7 ＠＠
# directory itself).
#ARC_DIR = /path/to/your/$LIST.w3archive
-ARC_DIR = /web/http-xemacs/list-archive/$LIST
+ARC_DIR = /archives/http-xemacs/list-archive/$LIST
# [ wilma ]
# URL path of the HTML archive directories if different than the file
Index: cgi-bin/.wilma/xemacs-build-reports.cf
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacsweb/cgi-bin/.wilma/xemacs-build-reports.cf,v
retrieving revision 1.1
diff -u -w -r1.1 xemacs-build-reports.cf
--- cgi-bin/.wilma/xemacs-build-reports.cf 18 Jul 2003 21:46:19 -0000 1.1
+++ cgi-bin/.wilma/xemacs-build-reports.cf 27 Feb 2005 19:31:09 -0000
＠＠ -19,7 +19,7 ＠＠
# directory itself).
#ARC_DIR = /path/to/your/$LIST.w3archive
-ARC_DIR = /web/http-xemacs/list-archive/$LIST
+ARC_DIR = /archives/http-xemacs/list-archive/$LIST
# [ wilma ]
# URL path of the HTML archive directories if different than the file
Index: cgi-bin/.wilma/xemacs-cvs.cf
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacsweb/cgi-bin/.wilma/xemacs-cvs.cf,v
retrieving revision 1.1
diff -u -w -r1.1 xemacs-cvs.cf
--- cgi-bin/.wilma/xemacs-cvs.cf 18 Jul 2003 21:46:19 -0000 1.1
+++ cgi-bin/.wilma/xemacs-cvs.cf 27 Feb 2005 19:31:09 -0000
＠＠ -19,7 +19,7 ＠＠
# directory itself).
#ARC_DIR = /path/to/your/$LIST.w3archive
-ARC_DIR = /web/http-xemacs/list-archive/$LIST
+ARC_DIR = /archives/http-xemacs/list-archive/$LIST
# [ wilma ]
# URL path of the HTML archive directories if different than the file
Index: cgi-bin/.wilma/xemacs-design.cf
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacsweb/cgi-bin/.wilma/xemacs-design.cf,v
retrieving revision 1.1
diff -u -w -r1.1 xemacs-design.cf
--- cgi-bin/.wilma/xemacs-design.cf 18 Jul 2003 21:46:19 -0000 1.1
+++ cgi-bin/.wilma/xemacs-design.cf 27 Feb 2005 19:31:09 -0000
＠＠ -19,7 +19,7 ＠＠
# directory itself).
#ARC_DIR = /path/to/your/$LIST.w3archive
-ARC_DIR = /web/http-xemacs/list-archive/$LIST
+ARC_DIR = /archives/http-xemacs/list-archive/$LIST
# [ wilma ]
# URL path of the HTML archive directories if different than the file
Index: cgi-bin/.wilma/xemacs-mule.cf
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacsweb/cgi-bin/.wilma/xemacs-mule.cf,v
retrieving revision 1.1
diff -u -w -r1.1 xemacs-mule.cf
--- cgi-bin/.wilma/xemacs-mule.cf 18 Jul 2003 21:46:19 -0000 1.1
+++ cgi-bin/.wilma/xemacs-mule.cf 27 Feb 2005 19:31:09 -0000
＠＠ -19,7 +19,7 ＠＠
# directory itself).
#ARC_DIR = /path/to/your/$LIST.w3archive
-ARC_DIR = /web/http-xemacs/list-archive/$LIST
+ARC_DIR = /archives/http-xemacs/list-archive/$LIST
# [ wilma ]
# URL path of the HTML archive directories if different than the file
Index: cgi-bin/.wilma/xemacs-nt.cf
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacsweb/cgi-bin/.wilma/xemacs-nt.cf,v
retrieving revision 1.1
diff -u -w -r1.1 xemacs-nt.cf
--- cgi-bin/.wilma/xemacs-nt.cf 18 Jul 2003 21:46:19 -0000 1.1
+++ cgi-bin/.wilma/xemacs-nt.cf 27 Feb 2005 19:31:09 -0000
＠＠ -19,7 +19,7 ＠＠
# directory itself).
#ARC_DIR = /path/to/your/$LIST.w3archive
-ARC_DIR = /web/http-xemacs/list-archive/$LIST
+ARC_DIR = /archives/http-xemacs/list-archive/$LIST
# [ wilma ]
# URL path of the HTML archive directories if different than the file
Index: cgi-bin/.wilma/xemacs-patches.cf
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacsweb/cgi-bin/.wilma/xemacs-patches.cf,v
retrieving revision 1.1
diff -u -w -r1.1 xemacs-patches.cf
--- cgi-bin/.wilma/xemacs-patches.cf 18 Jul 2003 21:46:19 -0000 1.1
+++ cgi-bin/.wilma/xemacs-patches.cf 27 Feb 2005 19:31:09 -0000
＠＠ -19,7 +19,7 ＠＠
# directory itself).
#ARC_DIR = /path/to/your/$LIST.w3archive
-ARC_DIR = /web/http-xemacs/list-archive/$LIST
+ARC_DIR = /archives/http-xemacs/list-archive/$LIST
# [ wilma ]
# URL path of the HTML archive directories if different than the file
Index: cgi-bin/.wilma/xemacs-review.cf
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacsweb/cgi-bin/.wilma/xemacs-review.cf,v
retrieving revision 1.1
diff -u -w -r1.1 xemacs-review.cf
--- cgi-bin/.wilma/xemacs-review.cf 18 Jul 2003 21:46:19 -0000 1.1
+++ cgi-bin/.wilma/xemacs-review.cf 27 Feb 2005 19:31:09 -0000
＠＠ -19,7 +19,7 ＠＠
# directory itself).
#ARC_DIR = /path/to/your/$LIST.w3archive
-ARC_DIR = /web/http-xemacs/list-archive/$LIST
+ARC_DIR = /archives/http-xemacs/list-archive/$LIST
# [ wilma ]
# URL path of the HTML archive directories if different than the file
Index: cgi-bin/.wilma/xemacs-users-ja.cf
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacsweb/cgi-bin/.wilma/xemacs-users-ja.cf,v
retrieving revision 1.1
diff -u -w -r1.1 xemacs-users-ja.cf
--- cgi-bin/.wilma/xemacs-users-ja.cf 18 Jul 2003 21:46:19 -0000 1.1
+++ cgi-bin/.wilma/xemacs-users-ja.cf 27 Feb 2005 19:31:09 -0000
＠＠ -19,7 +19,7 ＠＠
# directory itself).
#ARC_DIR = /path/to/your/$LIST.w3archive
-ARC_DIR = /web/http-xemacs/list-archive/$LIST
+ARC_DIR = /archives/http-xemacs/list-archive/$LIST
# [ wilma ]
# URL path of the HTML archive directories if different than the file
Index: cgi-bin/.wilma/xemacs-users-ru.cf
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacsweb/cgi-bin/.wilma/xemacs-users-ru.cf,v
retrieving revision 1.1
diff -u -w -r1.1 xemacs-users-ru.cf
--- cgi-bin/.wilma/xemacs-users-ru.cf 18 Jul 2003 21:46:19 -0000 1.1
+++ cgi-bin/.wilma/xemacs-users-ru.cf 27 Feb 2005 19:31:09 -0000
＠＠ -19,7 +19,7 ＠＠
# directory itself).
#ARC_DIR = /path/to/your/$LIST.w3archive
-ARC_DIR = /web/http-xemacs/list-archive/$LIST
+ARC_DIR = /archives/http-xemacs/list-archive/$LIST
# [ wilma ]
# URL path of the HTML archive directories if different than the file
Index: cgi-bin/.wilma/xemacs.cf
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacsweb/cgi-bin/.wilma/xemacs.cf,v
retrieving revision 1.1
diff -u -w -r1.1 xemacs.cf
--- cgi-bin/.wilma/xemacs.cf 18 Jul 2003 21:46:19 -0000 1.1
+++ cgi-bin/.wilma/xemacs.cf 27 Feb 2005 19:31:09 -0000
＠＠ -19,7 +19,7 ＠＠
# directory itself).
#ARC_DIR = /path/to/your/$LIST.w3archive
-ARC_DIR = /web/http-xemacs/list-archive/$LIST
+ARC_DIR = /archives/http-xemacs/list-archive/$LIST
# [ wilma ]
# URL path of the HTML archive directories if different than the file
--
Adrian Aichner
mailto:adrian＠xemacs.org
http://www.xemacs.org/
- 2 participants
- 1 comments
[PATCH] Proposed new package; re-builder, from the FSF. Date: 05/02/27 18:24:43) NEW: XEmacs/packages/xemacs-packages/re-builder
19 years, 7 months
Aidan Kehoe
Aidan Kehoe
Ar an seachtú lá is fiche de mí Feabhra, scríobh xemacs-cvs(a)xemacs.org:
> Subject: CVS update by aidan ( User: aidan
>
> XEmacs/packages/xemacs-packages/re-builder - New directory
Hmm, lesson learned there--looks like cvs add on a directory, unlike when
you do it on a file, doesn’t wait for the commit command before adding
it. Oops.
I haven’t written an info file for this package, because I just about know
how to use it. I think it is worth adding all the same--it’s one of the
coolest development tools on any emacs.
Index: xemacs-packages/re-builder/ChangeLog
===================================================================
RCS file: ChangeLog
diff -N ChangeLog
--- /dev/null Sun Feb 27 18:30:04 2005
+++ xemacs-packages/re-builder/ChangeLog Sun Feb 27 18:30:04 2005
＠＠ -0,0 +1,4 ＠＠
+2005-02-27 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * Makefile: Created.
+
Index: xemacs-packages/re-builder/Makefile
===================================================================
RCS file: Makefile
diff -N Makefile
--- /dev/null Sun Feb 27 18:30:04 2005
+++ xemacs-packages/re-builder/Makefile Sun Feb 27 18:30:04 2005
＠＠ -0,0 +1,32 ＠＠
+# Makefile for the re-builder package.
+
+# This file is part of XEmacs.
+
+# XEmacs 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 2, or (at your option) any
+# later version.
+
+# XEmacs 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 XEmacs; see the file COPYING. If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+
+# The GNU Emacs CVS version of re-builder.el is canonical.
+
+VERSION = 1.0
+AUTHOR_VERSION = 1.20
+MAINTAINER = Aidan Kehoe <aidan(a)xemacs.org>
+PACKAGE = re-builder
+PKG_TYPE = regular
+REQUIRES = fsf-compat
+CATEGORY = standard
+
+ELCS = re-builder.elc
+
+include ../../XEmacs.rules
Index: xemacs-packages/re-builder/OUR-CHANGES
===================================================================
RCS file: OUR-CHANGES
diff -N OUR-CHANGES
--- /dev/null Sun Feb 27 18:30:04 2005
+++ xemacs-packages/re-builder/OUR-CHANGES Sun Feb 27 18:30:04 2005
＠＠ -0,0 +1,65 ＠＠
+Index: re-builder.el
+===================================================================
+RCS file: /cvsroot/emacs/emacs/lisp/emacs-lisp/re-builder.el,v
+retrieving revision 1.20
+diff -u -u -r1.20 re-builder.el
+--- re-builder.el 27 Feb 2005 10:35:51 -0000 1.20
++++ re-builder.el 27 Feb 2005 17:17:00 -0000
+＠＠ -71,6 +71,9 ＠＠
+ ;; is a package by me and its support may go away as it is nearly the
+ ;; same as the `sregex' package in Emacs)
+
++;; Note that the `sregex,' `rx' and `lisp-re' syntaxes will only be
++;; available in XEmacs if you've installed them yourself.
++
+ ;; Editing symbolic expressions is done through a major mode derived
+ ;; from `emacs-lisp-mode' so you'll get all the good stuff like
+ ;; automatic indentation and font-locking etc.
+＠＠ -148,9 +151,9 ＠＠
+
+ (defface reb-match-0
+ '((((class color) (background light))
+-:background "lightblue")
++ (:background "lightblue"))
+ (((class color) (background dark))
+-:background "steelblue4")
++ (:background "steelblue4"))
+ (t
+:inverse-video t))
+ "Used for displaying the whole match."
+＠＠ -158,9 +161,9 ＠＠
+
+ (defface reb-match-1
+ '((((class color) (background light))
+-:background "aquamarine")
++ (:background "aquamarine"))
+ (((class color) (background dark))
+-:background "blue3")
++ (:background "blue3"))
+ (t
+:inverse-video t))
+ "Used for displaying the first matching subexpression."
+＠＠ -168,9 +171,9 ＠＠
+
+ (defface reb-match-2
+ '((((class color) (background light))
+-:background "springgreen")
++ (:background "springgreen"))
+ (((class color) (background dark))
+-:background "chartreuse4")
++ (:background "chartreuse4"))
+ (t
+:inverse-video t))
+ "Used for displaying the second matching subexpression."
+＠＠ -178,9 +181,9 ＠＠
+
+ (defface reb-match-3
+ '((((class color) (background light))
+-:background "yellow")
++ (:background "yellow"))
+ (((class color) (background dark))
+-:background "sienna4")
++ (:background "sienna4"))
+ (t
+:inverse-video t))
+ "Used for displaying the third matching subexpression."
Index: xemacs-packages/re-builder/package-info.in
===================================================================
RCS file: package-info.in
diff -N package-info.in
--- /dev/null Sun Feb 27 18:30:04 2005
+++ xemacs-packages/re-builder/package-info.in Sun Feb 27 18:30:04 2005
＠＠ -0,0 +1,19 ＠＠
+(re-builder
+ (standards-version 1.1
+ version VERSION
+ author-version AUTHOR_VERSION
+ date DATE
+ build-date BUILD_DATE
+ maintainer MAINTAINER
+ distribution xemacs
+ priority medium
+ category CATEGORY
+ dump nil
+ description "Interactive development tool for regular expressions."
+ filename FILENAME
+ md5sum MD5SUM
+ size SIZE
+ provides (re-builder)
+ requires (REQUIRES)
+ type regular
+))
Index: xemacs-packages/re-builder/re-builder.el
===================================================================
RCS file: re-builder.el
diff -N re-builder.el
--- /dev/null Sun Feb 27 18:30:04 2005
+++ xemacs-packages/re-builder/re-builder.el Sun Feb 27 18:30:04 2005
＠＠ -0,0 +1,699 ＠＠
+;;; re-builder.el --- building Regexps with visual feedback
+
+;; Copyright (C) 1999, 2000, 2001, 2002, 2004 Free Software Foundation, Inc.
+
+;; Author: Detlev Zundel <dzu(a)gnu.org>
+;; Keywords: matching, lisp, tools
+
+;; 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 2, 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; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; When I have to come up with regular expressions that are more
+;; complex than simple string matchers, especially if they contain sub
+;; expressions, I find myself spending quite some time in the
+;; `development cycle'. `re-builder' aims to shorten this time span
+;; so I can get on with the more interesting bits.
+
+;; With it you can have immediate visual feedback about how well the
+;; regexp behaves to your expectations on the intended data.
+
+;; When called up `re-builder' attaches itself to the current buffer
+;; which becomes its target buffer, where all the matching is done.
+;; The active window is split so you have a view on the data while
+;; authoring the RE. If the edited expression is valid the matches in
+;; the target buffer are marked automatically with colored overlays
+;; (for non-color displays see below) giving you feedback over the
+;; extents of the matched (sub) expressions. The (non-)validity is
+;; shown only in the modeline without throwing the errors at you. If
+;; you want to know the reason why RE Builder considers it as invalid
+;; call `reb-force-update' ("\C-c\C-u") which should reveal the error.
+
+;; The target buffer can be changed with `reb-change-target-buffer'
+;; ("\C-c\C-b"). Changing the target buffer automatically removes
+;; the overlays from the old buffer and displays the new one in the
+;; target window.
+
+;; The `re-builder' keeps the focus while updating the matches in the
+;; target buffer so corrections are easy to incorporate. If you are
+;; satisfied with the result you can paste the RE to the kill-ring
+;; with `reb-copy' ("\C-c\C-w"), quit the `re-builder' ("\C-c\C-q")
+;; and use it wherever you need it.
+
+;; As the automatic updates can take some time on large buffers, they
+;; can be limited by `reb-auto-match-limit' so that they should not
+;; have a negative impact on the editing. Setting it to nil makes
+;; even the auto updates go all the way. Forcing an update overrides
+;; this limit allowing an easy way to see all matches.
+
+;; Currently `re-builder' understands five different forms of input,
+;; namely `read', `string', `rx', `sregex' and `lisp-re' syntax. Read
+;; syntax and string syntax are both delimited by `"'s and behave
+;; according to their name. With the `string' syntax there's no need
+;; to escape the backslashes and double quotes simplifying the editing
+;; somewhat. The other three allow editing of symbolic regular
+;; expressions supported by the packages of the same name. (`lisp-re'
+;; is a package by me and its support may go away as it is nearly the
+;; same as the `sregex' package in Emacs)
+
+;; Note that the `sregex,' `rx' and `lisp-re' syntaxes will only be
+;; available in XEmacs if you've installed them yourself.
+
+;; Editing symbolic expressions is done through a major mode derived
+;; from `emacs-lisp-mode' so you'll get all the good stuff like
+;; automatic indentation and font-locking etc.
+
+;; When editing a symbolic regular expression, only the first
+;; expression in the RE Builder buffer is considered, which helps
+;; limiting the extent of the expression like the `"'s do for the text
+;; modes. For the `sregex' syntax the function `sregex' is applied to
+;; the evaluated expression read. So you can use quoted arguments
+;; with something like '("findme") or you can construct arguments to
+;; your hearts delight with a valid ELisp expression. (The compiled
+;; string form will be copied by `reb-copy') If you want to take
+;; a glance at the corresponding string you can temporarily change the
+;; input syntax.
+
+;; Changing the input syntax is transparent (for the obvious exception
+;; non-symbolic -> symbolic) so you can change your mind as often as
+;; you like.
+
+;; There is also a shortcut function for toggling the
+;; `case-fold-search' variable in the target buffer with an immediate
+;; update.
+
+
+;; Q: But what if my display cannot show colored overlays?
+;; A: Then the cursor will flash around the matched text making it stand
+;; out.
+
+;; Q: But how can I then make out the sub-expressions?
+;; A: Thats where the `sub-expression mode' comes in. In it only the
+;; digit keys are assigned to perform an update that will flash the
+;; corresponding subexp only.
+
+
+;;; Code:
+
+;; On XEmacs, load the overlay compatibility library
+(if (not (fboundp 'make-overlay))
+ (require 'overlay))
+
+;; User costomizable variables
+(defgroup re-builder nil
+ "Options for the RE Builder."
+:group 'lisp
+:prefix "reb-")
+
+(defcustom reb-blink-delay 0.5
+ "*Seconds to blink cursor for next/previous match in RE Builder."
+:group 're-builder
+:type 'number)
+
+(defcustom reb-mode-hook nil
+ "*Hooks to run on entering RE Builder mode."
+:group 're-builder
+:type 'hook)
+
+(defcustom reb-re-syntax 'read
+ "*Syntax for the REs in the RE Builder.
+Can either be `read', `string', `sregex' or `lisp-re'."
+:group 're-builder
+:type '(choice (const :tag "Read syntax" read)
+ (const :tag "String syntax" string)
+ (const :tag "`sregex' syntax" sregex)
+ (const :tag "`lisp-re' syntax" lisp-re)
+ (const :tag "`rx' syntax" rx)
+ (value: string)))
+
+(defcustom reb-auto-match-limit 200
+ "*Positive integer limiting the matches for RE Builder auto updates.
+Set it to nil if you don't want limits here."
+:group 're-builder
+:type '(restricted-sexp :match-alternatives
+ (integerp 'nil)))
+
+
+(defface reb-match-0
+ '((((class color) (background light))
+ (:background "lightblue"))
+ (((class color) (background dark))
+ (:background "steelblue4"))
+ (t
+:inverse-video t))
+ "Used for displaying the whole match."
+:group 're-builder)
+
+(defface reb-match-1
+ '((((class color) (background light))
+ (:background "aquamarine"))
+ (((class color) (background dark))
+ (:background "blue3"))
+ (t
+:inverse-video t))
+ "Used for displaying the first matching subexpression."
+:group 're-builder)
+
+(defface reb-match-2
+ '((((class color) (background light))
+ (:background "springgreen"))
+ (((class color) (background dark))
+ (:background "chartreuse4"))
+ (t
+:inverse-video t))
+ "Used for displaying the second matching subexpression."
+:group 're-builder)
+
+(defface reb-match-3
+ '((((class color) (background light))
+ (:background "yellow"))
+ (((class color) (background dark))
+ (:background "sienna4"))
+ (t
+:inverse-video t))
+ "Used for displaying the third matching subexpression."
+:group 're-builder)
+
+;; Internal variables below
+(defvar reb-mode nil
+ "Enables the RE Builder minor mode.")
+
+(defvar reb-target-buffer nil
+ "Buffer to which the RE is applied to.")
+
+(defvar reb-target-window nil
+ "Window to which the RE is applied to.")
+
+(defvar reb-regexp nil
+ "Last regexp used by RE Builder.")
+
+(defvar reb-regexp-src nil
+ "Last regexp used by RE Builder before processing it.
+Except for Lisp syntax this is the same as `reb-regexp'.")
+
+(defvar reb-overlays nil
+ "List of overlays of the RE Builder.")
+
+(defvar reb-window-config nil
+ "Old window configuration.")
+
+(defvar reb-subexp-mode nil
+ "Indicates whether sub-exp mode is active.")
+
+(defvar reb-subexp-displayed nil
+ "Indicates which sub-exp is active.")
+
+(defvar reb-mode-string ""
+ "String in mode line for additional info.")
+
+(defvar reb-valid-string ""
+ "String in mode line showing validity of RE.")
+
+(make-variable-buffer-local 'reb-overlays)
+(make-variable-buffer-local 'reb-regexp)
+(make-variable-buffer-local 'reb-regexp-src)
+
+(defconst reb-buffer "*RE-Builder*"
+ "Buffer to use for the RE Builder.")
+
+;; Define the local "\C-c" keymap
+(defvar reb-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-c\C-c" 'reb-toggle-case)
+ (define-key map "\C-c\C-q" 'reb-quit)
+ (define-key map "\C-c\C-w" 'reb-copy)
+ (define-key map "\C-c\C-s" 'reb-next-match)
+ (define-key map "\C-c\C-r" 'reb-prev-match)
+ (define-key map "\C-c\C-i" 'reb-change-syntax)
+ (define-key map "\C-c\C-e" 'reb-enter-subexp-mode)
+ (define-key map "\C-c\C-b" 'reb-change-target-buffer)
+ (define-key map "\C-c\C-u" 'reb-force-update)
+ map)
+ "Keymap used by the RE Builder.")
+
+(defun reb-mode ()
+ "Major mode for interactively building Regular Expressions.
+\\{reb-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (setq major-mode 'reb-mode
+ mode-name "RE Builder")
+ (use-local-map reb-mode-map)
+ (reb-mode-common)
+ (run-hooks 'reb-mode-hook))
+
+(define-derived-mode reb-lisp-mode
+ emacs-lisp-mode "RE Builder Lisp"
+ "Major mode for interactively building symbolic Regular Expressions."
+ (cond ((eq reb-re-syntax 'lisp-re) ; Pull in packages
+ (require 'lisp-re)) ; as needed
+ ((eq reb-re-syntax 'sregex) ; sregex is not autoloaded
+ (require 'sregex)) ; right now..
+ ((eq reb-re-syntax 'rx) ; rx-to-string is autoloaded
+ (require 'rx))) ; require rx anyway
+ (reb-mode-common))
+
+;; Use the same "\C-c" keymap as `reb-mode' and use font-locking from
+;; `emacs-lisp-mode'
+(define-key reb-lisp-mode-map "\C-c"
+ (lookup-key reb-mode-map "\C-c"))
+
+(defvar reb-subexp-mode-map
+ (let ((m (make-keymap)))
+ (suppress-keymap m)
+ ;; Again share the "\C-c" keymap for the commands
+ (define-key m "\C-c" (lookup-key reb-mode-map "\C-c"))
+ (define-key m "q" 'reb-quit-subexp-mode)
+ (dotimes (digit 10)
+ (define-key m (int-to-string digit) 'reb-display-subexp))
+ m)
+ "Keymap used by the RE Builder for the subexpression mode.")
+
+(defun reb-mode-common ()
+ "Setup functions common to functions `reb-mode' and `reb-mode-lisp'."
+
+ (setq reb-mode-string ""
+ reb-valid-string ""
+ mode-line-buffer-identification
+ '(25 . ("%b" reb-mode-string reb-valid-string)))
+ (reb-update-modestring)
+ (make-local-variable 'after-change-functions)
+ (add-hook 'after-change-functions
+ 'reb-auto-update)
+ ;; At least make the overlays go away if the buffer is killed
+ (make-local-variable 'reb-kill-buffer)
+ (add-hook 'kill-buffer-hook 'reb-kill-buffer)
+ (reb-auto-update nil nil nil))
+
+
+;; Handy macro for doing things in other windows
+(defmacro reb-with-current-window (window &rest body)
+ "With WINDOW selected evaluate BODY forms and reselect previous window."
+
+ (let ((oldwindow (make-symbol "*oldwindow*")))
+ `(let ((,oldwindow (selected-window)))
+ (select-window ,window)
+ (unwind-protect
+ (progn
+ ,＠body)
+ (select-window ,oldwindow)))))
+(put 'reb-with-current-window 'lisp-indent-function 0)
+
+(defun reb-color-display-p ()
+ "Return t if display is capable of displaying colors."
+ (eq 'color
+ ;; emacs/xemacs compatibility
+ (if (fboundp 'frame-parameter)
+ (frame-parameter (selected-frame) 'display-type)
+ (frame-property (selected-frame) 'display-type))))
+
+(defsubst reb-lisp-syntax-p ()
+ "Return non-nil if RE Builder uses a Lisp syntax."
+ (memq reb-re-syntax '(lisp-re sregex rx)))
+
+(defmacro reb-target-binding (symbol)
+ "Return binding for SYMBOL in the RE Builder target buffer."
+ `(with-current-buffer reb-target-buffer ,symbol))
+
+;;; This is to help people find this in Apropos.
+;;;###autoload
+(defun regexp-builder ()
+ "Alias for `re-builder': Construct a regexp interactively."
+ (interactive)
+ (re-builder))
+
+;;;###autoload
+(defun re-builder ()
+ "Construct a regexp interactively."
+ (interactive)
+
+ (if (and (string= (buffer-name) reb-buffer)
+ (memq major-mode '(reb-mode reb-lisp-mode)))
+ (message "Already in the RE Builder")
+ (if reb-target-buffer
+ (reb-delete-overlays))
+ (setq reb-target-buffer (current-buffer)
+ reb-target-window (selected-window)
+ reb-window-config (current-window-configuration))
+ (select-window (split-window (selected-window) (- (window-height) 4)))
+ (switch-to-buffer (get-buffer-create reb-buffer))
+ (erase-buffer)
+ (reb-insert-regexp)
+ (goto-char (+ 2 (point-min)))
+ (cond
+ ((reb-lisp-syntax-p)
+ (reb-lisp-mode))
+ (t (reb-mode)))))
+
+(defun reb-change-target-buffer (buf)
+ "Change the target buffer and display it in the target window."
+ (interactive "bSet target buffer to: ")
+
+ (let ((buffer (get-buffer buf)))
+ (if (not buffer)
+ (error "No such buffer")
+ (reb-delete-overlays)
+ (setq reb-target-buffer buffer)
+ (reb-do-update
+ (if reb-subexp-mode reb-subexp-displayed nil))
+ (reb-update-modestring))))
+
+(defun reb-force-update ()
+ "Force an update in the RE Builder target window without a match limit."
+ (interactive)
+
+ (let ((reb-auto-match-limit nil))
+ (reb-update-overlays
+ (if reb-subexp-mode reb-subexp-displayed nil))))
+
+(defun reb-quit ()
+ "Quit the RE Builder mode."
+ (interactive)
+
+ (setq reb-subexp-mode nil
+ reb-subexp-displayed nil)
+ (reb-delete-overlays)
+ (bury-buffer)
+ (set-window-configuration reb-window-config))
+
+(defun reb-next-match ()
+ "Go to next match in the RE Builder target window."
+ (interactive)
+
+ (reb-assert-buffer-in-window)
+ (reb-with-current-window
+ reb-target-window
+ (if (not (re-search-forward reb-regexp (point-max) t))
+ (message "No more matches.")
+ (reb-show-subexp
+ (or (and reb-subexp-mode reb-subexp-displayed) 0)
+ t))))
+
+(defun reb-prev-match ()
+ "Go to previous match in the RE Builder target window."
+ (interactive)
+
+ (reb-assert-buffer-in-window)
+ (reb-with-current-window reb-target-window
+ (goto-char (1- (point)))
+ (if (not (re-search-backward reb-regexp (point-min) t))
+ (message "No more matches.")
+ (reb-show-subexp
+ (or (and reb-subexp-mode reb-subexp-displayed) 0)
+ t))))
+
+(defun reb-toggle-case ()
+ "Toggle case sensitivity of searches for RE Builder target buffer."
+ (interactive)
+
+ (with-current-buffer reb-target-buffer
+ (setq case-fold-search (not case-fold-search)))
+ (reb-update-modestring)
+ (reb-auto-update nil nil nil t))
+
+(defun reb-copy ()
+ "Copy current RE into the kill ring for later insertion."
+ (interactive)
+
+ (reb-update-regexp)
+ (let ((re (with-output-to-string
+ (print (reb-target-binding reb-regexp)))))
+ (kill-new (substring re 1 (1- (length re))))
+ (message "Regexp copied to kill-ring")))
+
+;; The subexpression mode is not electric because the number of
+;; matches should be seen rather than a prompt.
+(defun reb-enter-subexp-mode ()
+ "Enter the subexpression mode in the RE Builder."
+ (interactive)
+ (setq reb-subexp-mode t)
+ (reb-update-modestring)
+ (use-local-map reb-subexp-mode-map)
+ (message "`0'-`9' to display subexpressions `q' to quit subexp mode."))
+
+(defun reb-show-subexp (subexp &optional pause)
+ "Visually show limit of subexpression SUBEXP of recent search.
+On color displays this just puts point to the end of the expression as
+the match should already be marked by an overlay.
+On other displays jump to the beginning and the end of it.
+If the optional PAUSE is non-nil then pause at the end in any case."
+ (reb-with-current-window reb-target-window
+ (if (not (reb-color-display-p))
+ (progn (goto-char (match-beginning subexp))
+ (sit-for reb-blink-delay)))
+ (goto-char (match-end subexp))
+ (if (or (not (reb-color-display-p)) pause)
+ (sit-for reb-blink-delay))))
+
+(defun reb-quit-subexp-mode ()
+ "Quit the subexpression mode in the RE Builder."
+ (interactive)
+ (setq reb-subexp-mode nil
+ reb-subexp-displayed nil)
+ (reb-update-modestring)
+ (use-local-map reb-mode-map)
+ (reb-do-update))
+
+(defun reb-change-syntax (&optional syntax)
+ "Change the syntax used by the RE Builder.
+Optional argument SYNTAX must be specified if called non-interactively."
+ (interactive
+ (list (intern
+ (completing-read "Select syntax: "
+ (mapcar (lambda (el) (cons (symbol-name el) 1))
+ '(read string lisp-re sregex rx))
+ nil t (symbol-name reb-re-syntax)))))
+
+ (if (memq syntax '(read string lisp-re sregex rx))
+ (let ((buffer (get-buffer reb-buffer)))
+ (setq reb-re-syntax syntax)
+ (if buffer
+ (with-current-buffer buffer
+ (erase-buffer)
+ (reb-insert-regexp)
+ (goto-char (+ 2 (point-min)))
+ (cond ((reb-lisp-syntax-p)
+ (reb-lisp-mode))
+ (t (reb-mode))))))
+ (error "Invalid syntax: %s" syntax)))
+
+
+;; Non-interactive functions below
+(defun reb-do-update (&optional subexp)
+ "Update matches in the RE Builder target window.
+If SUBEXP is non-nil mark only the corresponding sub-expressions."
+
+ (reb-assert-buffer-in-window)
+ (reb-update-regexp)
+ (reb-update-overlays subexp))
+
+(defun reb-auto-update (beg end lenold &optional force)
+ "Called from `after-update-functions' to update the display.
+BEG, END and LENOLD are passed in from the hook.
+An actual update is only done if the regexp has changed or if the
+optional fourth argument FORCE is non-nil."
+ (let ((prev-valid reb-valid-string)
+ (new-valid
+ (condition-case nil
+ (progn
+ (if (or (reb-update-regexp) force)
+ (progn
+ (reb-assert-buffer-in-window)
+ (reb-do-update)))
+ "")
+ (error " *invalid*"))))
+ (setq reb-valid-string new-valid)
+ (force-mode-line-update)
+
+ ;; Through the caching of the re a change invalidating the syntax
+ ;; for symbolic expressions will not delete the overlays so we
+ ;; catch it here
+ (if (and (reb-lisp-syntax-p)
+ (not (string= prev-valid new-valid))
+ (string= prev-valid ""))
+ (reb-delete-overlays))))
+
+(defun reb-delete-overlays ()
+ "Delete all RE Builder overlays in the `reb-target-buffer' buffer."
+ (if (buffer-live-p reb-target-buffer)
+ (with-current-buffer reb-target-buffer
+ (mapcar 'delete-overlay reb-overlays)
+ (setq reb-overlays nil))))
+
+(defun reb-assert-buffer-in-window ()
+ "Assert that `reb-target-buffer' is displayed in `reb-target-window'."
+
+ (if (not (eq reb-target-buffer (window-buffer reb-target-window)))
+ (set-window-buffer reb-target-window reb-target-buffer)))
+
+(defun reb-update-modestring ()
+ "Update the variable `reb-mode-string' displayed in the mode line."
+ (setq reb-mode-string
+ (concat
+ (if reb-subexp-mode
+ (format " (subexp %s)" (or reb-subexp-displayed "-"))
+ "")
+ (if (not (reb-target-binding case-fold-search))
+ " Case"
+ "")))
+ (force-mode-line-update))
+
+(defun reb-display-subexp (&optional subexp)
+ "Highlight only subexpression SUBEXP in the RE Builder."
+ (interactive)
+
+ (setq reb-subexp-displayed
+ (or subexp (string-to-int (format "%c" last-command-char))))
+ (reb-update-modestring)
+ (reb-do-update reb-subexp-displayed))
+
+(defun reb-kill-buffer ()
+ "When the RE Builder buffer is killed make sure no overlays stay around."
+
+ (if (member major-mode '(reb-mode reb-lisp-mode))
+ (reb-delete-overlays)))
+
+
+;; The next functions are the interface between the regexp and
+;; its textual representation in the RE Builder buffer.
+;; They are the only functions concerned with the actual syntax
+;; being used.
+(defun reb-read-regexp ()
+ "Read current RE."
+ (save-excursion
+ (cond ((eq reb-re-syntax 'read)
+ (goto-char (point-min))
+ (read (current-buffer)))
+ ((eq reb-re-syntax 'string)
+ (goto-char (point-min))
+ (re-search-forward "\"")
+ (let ((beg (point)))
+ (goto-char (point-max))
+ (re-search-backward "\"")
+ (buffer-substring-no-properties beg (point))))
+ ((reb-lisp-syntax-p)
+ (buffer-string)))))
+
+(defun reb-empty-regexp ()
+ "Return empty RE for current syntax."
+ (cond ((reb-lisp-syntax-p) "'()")
+ (t "")))
+
+(defun reb-insert-regexp ()
+ "Insert current RE."
+
+ (let ((re (or (reb-target-binding reb-regexp)
+ (reb-empty-regexp))))
+ (cond ((eq reb-re-syntax 'read)
+ (print re (current-buffer)))
+ ((eq reb-re-syntax 'string)
+ (insert "\n\"" re "\""))
+ ;; For the Lisp syntax we need the "source" of the regexp
+ ((reb-lisp-syntax-p)
+ (insert (or (reb-target-binding reb-regexp-src)
+ (reb-empty-regexp)))))))
+
+(defun reb-cook-regexp (re)
+ "Return RE after processing it according to `reb-re-syntax'."
+ (cond ((eq reb-re-syntax 'lisp-re)
+ (lre-compile-string (eval (car (read-from-string re)))))
+ ((eq reb-re-syntax 'sregex)
+ (apply 'sregex (eval (car (read-from-string re)))))
+ ((eq reb-re-syntax 'rx)
+ (rx-to-string (eval (car (read-from-string re)))))
+ (t re)))
+
+(defun reb-update-regexp ()
+ "Update the regexp for the target buffer.
+Return t if the (cooked) expression changed."
+ (let* ((re-src (reb-read-regexp))
+ (re (reb-cook-regexp re-src)))
+ (with-current-buffer reb-target-buffer
+ (let ((oldre reb-regexp))
+ (prog1
+ (not (string= oldre re))
+ (setq reb-regexp re)
+ ;; Only update the source re for the lisp formats
+ (if (reb-lisp-syntax-p)
+ (setq reb-regexp-src re-src)))))))
+
+
+;; And now the real core of the whole thing
+(defun reb-count-subexps (re)
+ "Return number of sub-expressions in the regexp RE."
+
+ (let ((i 0) (beg 0))
+ (while (string-match "\\\\(" re beg)
+ (setq i (1+ i)
+ beg (match-end 0)))
+ i))
+
+
+(defun reb-update-overlays (&optional subexp)
+ "Switch to `reb-target-buffer' and mark all matches of `reb-regexp'.
+If SUBEXP is non-nil mark only the corresponding sub-expressions."
+
+ (let* ((re (reb-target-binding reb-regexp))
+ (subexps (reb-count-subexps re))
+ (matches 0)
+ (submatches 0)
+ firstmatch)
+ (save-excursion
+ (set-buffer reb-target-buffer)
+ (reb-delete-overlays)
+ (goto-char (point-min))
+ (while (and (re-search-forward re (point-max) t)
+ (or (not reb-auto-match-limit)
+ (< matches reb-auto-match-limit)))
+ (if (= 0 (length (match-string 0)))
+ (error "Empty regular expression!"))
+ (let ((i 0))
+ (setq matches (1+ matches))
+ (while (<= i subexps)
+ (if (and (or (not subexp) (= subexp i))
+ (match-beginning i))
+ (let ((overlay (make-overlay (match-beginning i)
+ (match-end i)))
+ (face-name (format "reb-match-%d" i)))
+ (if (not firstmatch)
+ (setq firstmatch (match-data)))
+ (setq reb-overlays (cons overlay reb-overlays)
+ submatches (1+ submatches))
+ (overlay-put
+ overlay 'face
+ (or (intern-soft face-name)
+ (error "Too many subexpressions - face `%s' not defined"
+ face-name )))
+ (overlay-put overlay 'priority i)))
+ (setq i (1+ i))))))
+ (let ((count (if subexp submatches matches)))
+ (message "%s %smatch%s%s"
+ (if (= 0 count) "No" (int-to-string count))
+ (if subexp "subexpression " "")
+ (if (= 1 count) "" "es")
+ (if (and reb-auto-match-limit
+ (= reb-auto-match-limit count))
+ " (limit reached)" "")))
+ (if firstmatch
+ (progn (store-match-data firstmatch)
+ (reb-show-subexp (or subexp 0))))))
+
+(provide 're-builder)
+
+;;; arch-tag: 5c5515ac-4085-4524-a421-033f44f032e7
+;;; re-builder.el ends here
--
“I, for instance, am gung-ho about open source because my family is being
held hostage in Rob Malda’s basement. But who fact-checks me, or Enderle,
when we say something in public? No-one!” -- Danny O’Brien
- 2 participants
- 1 comments
[PATCH] Change default mail-user-agent to vm-user-agent
19 years, 7 months
Aidan Kehoe
Aidan Kehoe
As discussed a month or so ago.
lisp/ChangeLog addition:
2005-02-27 Aidan Kehoe <kehoea(a)parhasard.net>
* menubar-items.el (default-menubar):
Add an entry for VM in the list of mail composition agents.
* simple.el:
* simple.el (mail-user-agent):
Change the default mail user agent to VM; update the docstring to
give details of VM and cross-reference to the Info docs.
* simple.el ('vm-user-agent): New.
Define the vm-user-agent as a mail user agent.
man/ChangeLog addition:
2005-02-27 Aidan Kehoe <kehoea(a)parhasard.net>
* xemacs/sending.texi (Sending Mail): Note that the default user
agent is now VM, that it's compatible with sendmail.el, and
cross-reference to its documentation.
XEmacs Trunk source patch:
Diff command: cvs -q diff -u
Files affected: man/xemacs/sending.texi lisp/simple.el lisp/menubar-items.el
Index: lisp/menubar-items.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/menubar-items.el,v
retrieving revision 1.46
diff -u -u -r1.46 menubar-items.el
--- lisp/menubar-items.el 2005/02/03 05:03:38 1.46
+++ lisp/menubar-items.el 2005/02/27 18:31:53
＠＠ -886,7 +886,11 ＠＠
:active (boundp 'ps-print-color-p)])
("%_Internet"
("%_Compose Mail With"
- ["Default Emacs Mailer"
+ ["VM mail client"
+ (customize-set-variable 'mail-user-agent 'vm-user-agent)
+ :style radio
+ :selected (eq mail-user-agent 'vm-user-agent)]
+ ["GNU Emacs Mailer"
(customize-set-variable 'mail-user-agent 'sendmail-user-agent)
:style radio
:selected (eq mail-user-agent 'sendmail-user-agent)]
Index: lisp/simple.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/simple.el,v
retrieving revision 1.50
diff -u -u -r1.50 simple.el
--- lisp/simple.el 2005/02/23 22:25:16 1.50
+++ lisp/simple.el 2005/02/27 18:31:57
＠＠ -3306,16 +3306,21 ＠＠
;; BEGIN SYNCHED WITH FSF 21.2.
-(defcustom mail-user-agent 'sendmail-user-agent
+(defcustom mail-user-agent 'vm-user-agent
"*Your preference for a mail composition package.
Various Emacs Lisp packages (e.g. Reporter) require you to compose an
outgoing email message. This variable lets you specify which
mail-sending package you prefer.
-Valid values include:
-
- `sendmail-user-agent' -- use the default Emacs Mail package.
- See Info node `(emacs)Sending Mail'.
+Valid values may include:
+
+ `vm-user-agent' -- use Kyle Jones' VM, as documented in the `(vm)'
+ Info node. Compatible with `sendmail-user-agent',
+ and can handle attachments and non-ASCII content,
+ which the former can't.
+ `sendmail-user-agent' -- use the former default, bare-bones, Emacs Mail
+ package, as still used in GNU Emacs. See Info
+ node `(xemacs)Sending Mail'.
`mh-e-user-agent' -- use the Emacs interface to the MH mail system.
See Info node `(mh-e)'.
`message-user-agent' -- use the Gnus Message package.
＠＠ -3329,7 +3334,10 ＠＠
succeeds.
See also `read-mail-command' concerning reading mail."
-:type '(radio (function-item :tag "Default Emacs mail"
+:type '(radio (function-item :tag "VM mail client"
+ :format "%t\n"
+ vm-user-agent)
+ (function-item :tag "GNU Emacs mail"
:format "%t\n"
sendmail-user-agent)
(function-item :tag "Emacs interface to MH"
＠＠ -3385,6 +3393,12 ＠＠
(define-mail-user-agent 'message-user-agent
'message-mail 'message-send-and-exit
'message-kill-buffer 'message-send-hook)
+
+(define-mail-user-agent 'vm-user-agent
+ (function vm-compose-mail) ; compose function
+ (function vm-mail-send-and-exit) ; send function
+ nil ; abort function (kill-buffer)
+ nil) ; hook variable (mail-send-hook)
(defun rfc822-goto-eoh ()
;; Go to header delimiter line in a mail message, following RFC822 rules
Index: man/xemacs/sending.texi
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/man/xemacs/sending.texi,v
retrieving revision 1.4
diff -u -u -r1.4 sending.texi
--- man/xemacs/sending.texi 2001/04/12 18:22:30 1.4
+++ man/xemacs/sending.texi 2005/02/27 18:31:57
＠＠ -40,6 +40,12 ＠＠
＠kbd{C-u C-x m} is another way to switch back to a message in progress:
it will search for an existing, unsent mail message buffer and select it.
+Starting with version 21.5, the default mail composition package in
+XEmacs is VM, which is compatible with `sendmail.el' (the old default,
+as described in this document) and has thorough support for attachments
+and non-ASCII messages. ＠pxref{(vm)}, for the full VM documentation,
+should you want information on those features.
+
＠menu
* Format: Mail Format. Format of the mail being composed.
* Headers: Mail Headers. Details of allowed mail header fields.
--
“I, for instance, am gung-ho about open source because my family is being
held hostage in Rob Malda’s basement. But who fact-checks me, or Enderle,
when we say something in public? No-one!” -- Danny O’Brien
- 2 participants
- 4 comments
[21.5]: ldap -llber lost in 21.4
19 years, 7 months
Ilya N. Golubev
Ilya N. Golubev
A `configure' lossage was introuced in 21.5 branch by revision 1.232
of `configure.in'. On 27 Nov 2004 05:54:42 GMT Ben Wing wrote
(<20041127055442.19012.qmail(a)666.com>, cc: <xemacs-beta(a)xemacs.org>)
about it:
> this is my bad. i tried to fix a problem recently and broke things
> when --with-ldap is explicitly given.
On 2005/01/23 16:22:57 GMT you (vins) committed the same changes that
broke 21.5, without any fix, in 21.4 branch as revision 1.151.2.30.
Now `configure' in 21.4 breaks on the same systems and for the same
reasons, as it did after revision 1.232 change in 21.5. Please either
roll back the change in 21.4 or fix it both there and in 21.5.
If choose to do the latter. <ldap -llber lost> posted to
<xemacs-beta(a)xemacs.org> on Fri, 26 Nov 2004 22:57:47 +0300
(<027c41a78aba26-gin(a)mo.msk.ru>) described the bug as follows:
> Change in revision 1.232 of `configure.in' caused lossage in the
> following circumstances.
>
> . System ldap applications must be linked with `-lldap -llber'.
> Linking with `-lldap' only causes undefined symbol errors.
>
> . `--with-ldap' arg was specified to `configure'.
>
> In this case `configure' fails to detect library that must be linked
> to use ldap. `with_ldap' is `yes', and appropriate `AC_CHECK_LIB' is
> not called. `with_ldap_lber' left unset, and `ldap_libs' are not set
> properly. This breaks further check of ldap toolkit features and
> `eldap.c' compilation.
>
> Never checked other ldap toolkits with other sets of required
> libraries.
>
> Please decide what should mean that `--with-ldap' was specified by
> `configure' caller and what should mean success of some stage of ldap
> toolkit auto-detection, and fix the confusion.
Currently fixing it in my local 21.5 branch as follows.
2004-12-20 Ilya N. Golubev <gin(a)mo.msk.ru>
* configure.in: Fix ldap libraries configuration lossage when
`-lldap -llber' links and but `-lldap' does not; the lossage was
introduced in revision 1.232. Also allow `ldap_libs' to be empty
or overridden by builder.
--- configure.in 12 Dec 2004 03:19:04 -0000 1.18
+++ configure.in 19 Dec 2004 21:10:02 -0000 1.19
＠＠ -3595,36 +3595,64 ＠＠
dnl Autodetect LDAP
AC_CHECKING(for LDAP)
-ldap_libs=
test -z "$with_ldap" && { AC_CHECK_HEADER(ldap.h, ,with_ldap=no) }
test -z "$with_ldap" && { AC_CHECK_HEADER(lber.h, ,with_ldap=no) }
-if test "$with_ldap" != "no"; then
- AC_CHECK_LIB(ldap, ldap_search, with_ldap=yes)
- dnl Check for other libraries we need to link with to get the main routines.
- test "$with_ldap" != "yes" && { AC_CHECK_LIB(ldap, ldap_open, [with_ldap=yes with_ldap_lber=yes], , -llber) }
- test "$with_ldap" != "yes" && { AC_CHECK_LIB(ldap, ldap_open, [with_ldap=yes with_ldap_lber=yes with_ldap_krb=yes], , -llber -lkrb) }
- test "$with_ldap" != "yes" && { AC_CHECK_LIB(ldap, ldap_open, [with_ldap=yes with_ldap_lber=yes with_ldap_krb=yes with_ldap_des=yes], , -llber -lkrb -ldes) }
- dnl Recently, we need -lber even though the main routines are elsewhere,
- dnl because otherwise be get link errors w.r.t. ber_pvt_opt_on. So just
- dnl check for that (it's a variable not a fun but that doesn't seem to
- dnl matter in these checks) and stick in -lber if so. Can't hurt (even to
- dnl stick it in always shouldn't hurt, I don't think) ... #### Someone who
- dnl #### understands LDAP needs to fix this properly.
- test "$with_ldap_lber" != "yes" && { AC_CHECK_LIB(lber, ber_pvt_opt_on, with_ldap_lber=yes) }
+if test no != "$with_ldap";then
+ if test . != "${ldap_libs+.}";then
+ ldap_libs=
+ AC_CHECK_FUNC(ldap_open,dnl Allow it to be in generic "$LIBS"
+ [with_ldap=yes
+ test yes = "$extra_verbose" &&
+ echo "Setting ldap_libs to $ldap_libs"],dnl
+ [AC_CHECK_LIB(ldap, ldap_open,dnl
+ [with_ldap=yes],dnl
+ [ldap_needs_lber=yes ldap_other_libs=-llber
+dnl This requires `AC_CACHE_VAL' (which is called by `AC_CHECK_LIB')
+dnl to be redefined to ignore cached (shell variable) value, as it is
+dnl done above, because the same variable is used in all
+dnl `AC_CHECK_LIB' expansions in macro invocation below. Worse, if it
+dnl is not done, there is no portable way to compensate for this
+dnl locally since `unset' command is not supported by all shells. The
+dnl other solution would be changing `AC_CHECK_LIB' so that cache
+dnl variable name depends on the macro OTHER-LIBRARIES argument.
+ AC_CHECK_LIB(ldap, ldap_open,dnl
+ [with_ldap=yes],dnl
+ [ldap_needs_krb=yes ldap_other_libs="$ldap_other_libs -lkrb"
+ AC_CHECK_LIB(ldap, ldap_open,dnl
+ [with_ldap=yes],dnl
+ [ldap_needs_des=yes ldap_other_libs="$ldap_other_libs -ldes"
+ AC_CHECK_LIB(ldap, ldap_open,dnl
+ [with_ldap=yes],dnl
+ [with_ldap=no],dnl
+ $ldap_other_libs)],dnl
+ $ldap_other_libs)],dnl
+ $ldap_other_libs)])
+ if test yes = "$with_ldap";then
+ if test yes = "$ldap_needs_des";then
+ XE_PREPEND(-ldes, ldap_libs)
+ fi
+ if test yes = "$ldap_needs_krb";then
+ XE_PREPEND(-lkrb, ldap_libs)
+ fi
+ if test yes = "$ldap_needs_lber";then
+ XE_PREPEND(-llber, ldap_libs)
+ fi
+ XE_PREPEND(-lldap, ldap_libs)
+ fi])
+ else
+dnl Allow builder to override "$ldap_libs".
+ save_LIBS="$LIBS" LIBS="$ldap_libs $LIBS"
+ AC_CHECK_FUNC(ldap_open,dnl
+ [with_ldap=yes
+ test yes = "$extra_verbose" &&
+ echo "Setting ldap_libs to $ldap_libs"],dnl
+ [with_ldap=no])
+ LIBS="$save_LIBS"
+ fi
fi
if test "$with_ldap" = "yes"; then
AC_DEFINE(HAVE_LDAP)
- if test "$with_ldap_des" = "yes" ; then
- XE_PREPEND(-ldes, ldap_libs)
- fi
- if test "$with_ldap_krb" = "yes" ; then
- XE_PREPEND(-lkrb, ldap_libs)
- fi
- if test "$with_ldap_lber" = "yes" ; then
- XE_PREPEND(-llber, ldap_libs)
- fi
- XE_PREPEND(-lldap, ldap_libs)
- save_LIBS="$LIBS" LIBS="$LIBS $ldap_libs"
+ save_LIBS="$LIBS" LIBS="$ldap_libs $LIBS"
AC_CHECK_FUNCS(ldap_set_option ldap_get_lderrno ldap_result2error ldap_parse_result)
LIBS="$save_LIBS"
XE_APPEND(modules/ldap, MAKE_SUBDIR)
- 3 participants
- 2 comments
[PATCH] General X11 selection cleanup.
19 years, 7 months
Aidan Kehoe
Aidan Kehoe
This incorporates Jamie’s patch of the middle of last year; a patch of mine
that did the same for outgoing data as did Jamie’s for incoming data; and a
fix to Esben’s problem where XEmacs wasn’t offering a TIMESTAMP for
selections. Beyond the first two patches--which made it possible to copy and
paste or middle-click non-ASCII text to and from apps that aren’t some form
of emacs--this makes it possible to paste images into XEmacs, though, since
the integration of images into XEmacs isn’t thorough, this is pretty much
cosmetic. We also do serious content negotiation for the first time.
It renames get-selection-timestamp to get-xemacs-selection-timestamp,
because the function never worked for non-XEmacs selections. It also reverts
it to returning a cons of sixteen-bit quantities, because X11 Time
quantities are always thirty-two bits wide, and Lisp needs to be able to
manipulate the data, not treating it as an opaque pointer, for pasting into
non-XEmacs apps.
Builds linked against Motif previous to this patch only offered TIMESTAMP,
TEXT and COMPOUND_TEXT as the types of XEmacs selections to make available;
I haven’t changed this, on the perhaps invalid assumption that people had
their reasons for this. If anyone knows this, tell me, because UTF8_STRING
gives much more functionality in 2005.
Comments and testing, especially testing on Windows, would be appreciated. I
don’t believe this adds any more functionality to copying and pasting there,
and I also don’t believe it’ll break any functionality there, but
reassurance of the latter would be helpful.
lisp/ChangeLog addition:
2005-02-26 Aidan Kehoe <kehoea(a)parhasard.net>
* mouse.el (insert-selection): Honour check-cutbuffer-p.
* select.el (selected-text-type): Removed.
* select.el (selection-preferred-types): New.
* select.el ('selected-text-type): New.
Rename selected-text-type to selection-preferred-types, now that
it's full of image types as fallbacks. Define an alias to the old
name.
* select.el (kill-primary-selection): deleted -> delete
* select.el (get-selection-no-error):
* select.el (get-selection):
* select.el (get-selection-foreign):
Reference selection-preferred-types instead of giving details of
which types these functions default to wanting.
* select.el (select-make-extent-for-selection): Comment that we
need to hook something similar into the rectangle functions.
* select.el (select-convert-in):
If we don't have a handler for an X11 selection, pass the value
itself as a string. Fixes X11 atoms.
* select.el (select-convert-to-timestamp): New.
Uses get-xemacs-selection-timestamp.
* select.el (select-convert-to-utf-8-text): New.
* select.el (select-convert-from-text): Removed.
The change in select-convert-in makes this irrelevant.
* select.el (select-convert-from-length): Removed.
We have a more generic integer conversion routine here.
* select.el (select-convert-from-filename): Removed.
The generic string conversion handles this.
* select.el (select-convert-from-ip-address): New.
Whee.
* select.el (select-convert-from-utf-8-text): New.
* select.el (select-convert-from-utf-16-le-text): New.
The various Mozilla-specific types need the utf-16 conversion;
utf-8 conversion is _in_ this season, didn't you know?
* select.el (select-convert-from-image-data): New.
Generic convert-an-image-to-a-space-with-end-glyph function. Used
by the next six functions.
* select.el (select-convert-from-image/gif): New.
* select.el (select-convert-from-image/jpeg): New.
* select.el (select-convert-from-image/png): New.
* select.el (select-convert-from-image/tiff): New.
* select.el (select-convert-from-image/xpm): New.
* select.el (select-convert-from-image/xbm): New.
Check if we have support for a given image format; if so, pass
back a space with the corresponding selection's image attached as
glyph data.
* select.el (select-convert-from-cf-unicodetext):
* select.el (select-convert-to-cf-text):
* select.el (select-convert-to-cf-unicodetext):
Check that the corresponding Windows coding systems are available
before trying to convert.
* select.el (selection-converter-out-alist):
* select.el (selection-converter-in-alist):
Update both lists to reflect the other changes in the file.
* x-select.el (x-selected-text-type):
Update the define-obsolete-variable-alias now selected-text-type
is called something else.
src/ChangeLog addition:
2005-02-26 Aidan Kehoe <kehoea(a)parhasard.net>
* select-gtk.c (emacs_gtk_selection_handle):
* select-gtk.c (emacs_gtk_selection_clear_event_handle):
Use get_selection_raw_timestamp instead of Fget_selection_timestamp.
* select-gtk.c (gtk_own_selection):
Cross reference to some debate in select-x.c
* select-x.c:
* select-x.c (x_handle_selection_request):
Discuss Time vs. time_t--I think Time is _always_ thirty-two-bit
and time_t is variable in size.
* select-x.c (x_handle_selection_clear):
Replace call to Fget_selection_timestamp with call to
get_selection_raw_time, check that pasted data pointer is non-zero
before trying to free it.
* select.c:
* select.c (Fown_selection_internal):
Informative comment! Shouldn't actually be needed outside of the X
world.
* select.c (get_selection_raw_time): New function.
* select.c (Fget_selection_timestamp): Rework to use
get_selection_raw_time.
* select.h:
Make get_selection_raw_time available.
XEmacs Trunk source patch:
Diff command: cvs -q diff -u
Files affected: src/select.h src/select.c src/select-x.c src/select-gtk.c lisp/x-select.el lisp/select.el lisp/mouse.el
Index: lisp/mouse.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mouse.el,v
retrieving revision 1.31
diff -u -u -r1.31 mouse.el
--- lisp/mouse.el 2005/01/26 04:47:14 1.31
+++ lisp/mouse.el 2005/02/26 20:42:59
＠＠ -125,13 +125,11 ＠＠
"Insert the current selection into buffer at point."
(interactive "P")
;; we fallback to the clipboard if the current selection is not existent
- (let ((text (if check-cutbuffer-p
- (or (get-selection-no-error)
- (get-cutbuffer)
- (get-selection-no-error 'CLIPBOARD)
- (error "No selection, clipboard or cut buffer available"))
- (or (get-selection-no-error)
- (get-selection 'CLIPBOARD)))))
+ (let ((text (or (get-selection-no-error 'PRIMARY)
+ (and check-cutbuffer-p (get-cutbuffer))
+ (get-selection-no-error 'CLIPBOARD)
+ (error "no selection: PRIMARY or CLIPBOARD")
+ )))
(cond (move-point-event
(mouse-set-point move-point-event)
(push-mark (point)))
Index: lisp/select.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/select.el,v
retrieving revision 1.13
diff -u -u -r1.13 select.el
--- lisp/select.el 2002/05/23 11:46:10 1.13
+++ lisp/select.el 2005/02/26 20:42:59
＠＠ -33,13 +33,25 ＠＠
;;; Code:
-(defvar selected-text-type
- (if (featurep 'mule) '(COMPOUND_TEXT STRING) 'STRING)
- "The type atom used to obtain selections from the X server.
-Can be either a valid X selection data type, or a list of such types.
-COMPOUND_TEXT and STRING are the most commonly used data types.
-If a list is provided, the types are tried in sequence until
-there is a successful conversion.")
+;; We prefer UTF8_STRING to COMPOUND_TEXT because, even though the latter
+;; gives us more information when taking data from other XEmacs invocations,
+;; Mozilla will happily give us broken COMPOUND_TEXT where a non-broken
+;; UTF8_STRING is available.
+(defvar selection-preferred-types
+ (let ((res '(UTF8_STRING COMPOUND_TEXT STRING image/png image/gif
+ image/jpeg image/tiff image/xpm image/xbm)))
+ (unless (featurep 'mule) (delq 'COMPOUND_TEXT res))
+ res)
+ "An ordered list of X11 type atoms for selections we want to receive.
+We prefer UTF8_STRING over COMPOUND_TEXT, for compatibility with a certain
+widely-used browser suite, and COMPOUND_TEXT over STRING. (COMPOUND_TEXT
+isn't available on non-Mule.) We also accept several image types.
+
+For compatibility, this can be a single atom. ")
+
+;; Renamed because it was just ridiculous for it to be mostly image formats
+;; and named selected-text-type.
+(define-obsolete-variable-alias 'selected-text-type 'selection-preferred-types)
(defvar selection-sets-clipboard nil
"Controls the selection's relationship to the clipboard.
＠＠ -56,7 +68,7 ＠＠
(cut-copy-clear-internal 'copy)))
(defun kill-primary-selection ()
- "Copy the selection to the Clipboard and the kill ring, then deleted it.
+ "Copy the selection to the Clipboard and the kill ring, then delete it.
This is similar to the command \\[kill-region] except that it will
save to the Clipboard even if that command doesn't, and it handles rectangles
properly."
＠＠ -97,34 +109,62 ＠＠
(defun get-selection-no-error (&optional type data-type)
"Return the value of a window-system selection.
-The argument TYPE (default `PRIMARY') says which selection,
-and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule)
-says how to convert the data. Returns NIL if there is no selection."
+The argument TYPE (default `PRIMARY') says which selection, and the argument
+DATA-TYPE (defaulting to the value of `selection-preferred-types'), says how
+to convert the data. Returns NIL if there is no selection."
(condition-case nil (get-selection type data-type) (t nil)))
(defun get-selection (&optional type data-type)
"Return the value of a window-system selection.
-The argument TYPE (default `PRIMARY') says which selection,
-and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule)
-says how to convert the data. If there is no selection an error is signalled.
-Not suitable in a `interprogram-paste-function', q.v."
+The argument TYPE (default `PRIMARY') says which selection, and the argument
+DATA-TYPE (defaulting to the value of, and compatible with,
+`selection-preferred-types') says how to convert the data. If
+there is no selection an error is signalled. Not suitable in a
+`interprogram-paste-function', q.v."
(or type (setq type 'PRIMARY))
- (or data-type (setq data-type selected-text-type))
+ (or data-type (setq data-type selection-preferred-types))
(if (consp data-type)
- (condition-case err
- (get-selection-internal type (car data-type))
- (selection-conversion-error
- (if (cdr data-type)
- (get-selection type (cdr data-type))
- (signal (car err) (cdr err)))))
+ (let ((targets (get-selection-internal type 'TARGETS))
+ res good-target)
+ (catch 'converted
+ (if targets
+ (dolist (current-preference data-type)
+ (condition-case err
+ (progn
+ (setq good-target nil)
+ ;; Tell me I don't need to do this and that we
+ ;; actually have a (member) that works on
+ ;; vectors.
+ (mapc '(lambda (x) (if (eq x current-preference)
+ (setq good-target t)))
+ targets)
+ (if (and good-target
+ (setq res (get-selection-internal
+ type current-preference)))
+ (throw 'converted res)))
+ (selection-conversion-error
+ nil))))
+ ;; The source app didn't offer us anything compatible in TARGETS,
+ ;; or they're not negotiating at all. (That is, we're probably not
+ ;; on X11.) Try to convert to the types specified by our caller,
+ ;; and throw an error if the last one of those fails.
+ (while data-type
+ (condition-case err
+ (progn
+ (setq res (get-selection-internal type (car data-type)))
+ (throw 'converted res))
+ (selection-conversion-error
+ (if (cdr data-type)
+ (setq data-type (pop data-type))
+ (signal (car err) (cdr err))))))))
(get-selection-internal type data-type)))
(defun get-selection-foreign (&optional type data-type)
"Return the value of a window-system selection, or nil if XEmacs owns it.
-The argument TYPE (default `PRIMARY') says which selection,
-and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule)
-says how to convert the data. If there is no selection an error is signalled.
-See `interprogram-paste-function' for more information."
+The argument TYPE (default `PRIMARY') says which selection, and the argument
+DATA-TYPE (defaulting to the value of `selection-preferred-types' which see)
+says how to convert the data. If there is no selection an error is
+signalled. See `interprogram-paste-function' for more information."
(unless (selection-owner-p type)
(get-selection type data-type)))
＠＠ -255,6 +295,8 ＠＠
;; Given a selection, this makes an extent in the buffer which holds that
;; selection, for highlighting purposes. If the selection isn't associated
;; with a buffer, this does nothing.
+ ;;
+ ;; Something similar needs to be hooked into the rectangle functions.
(let ((buffer nil)
(valid (and (extentp previous-extent)
(extent-object previous-extent)
＠＠ -391,8 +433,9 ＠＠
suitable internal representation otherwise."
(when value
(let ((handler-fn (cdr (assq type selection-converter-in-alist))))
- (when handler-fn
- (apply handler-fn (list selection type value))))))
+ (if handler-fn
+ (apply handler-fn (list selection type value))
+ value))))
(defun select-convert-out (selection type value)
"Attempt to convert the specified internal VALUE for the specified DATA-TYPE
＠＠ -439,13 +482,42 ＠＠
(buffer-substring (car value) (cdr value)))))
(t nil)))
+(defun select-convert-to-timestamp (selection type value)
+ (let ((ts (get-xemacs-selection-timestamp selection)))
+ (if ts (cons 'TIMESTAMP ts))))
+
+(defun select-convert-to-utf-8-text (selection type value)
+ (cond ((stringp value)
+ (cons 'UTF8_STRING (encode-coding-string value 'utf-8)))
+ ((extentp value)
+ (save-excursion
+ (set-buffer (extent-object value))
+ (save-restriction
+ (widen)
+ (cons 'UTF8_STRING
+ (encode-coding-string
+ (buffer-substring (extent-start-position value)
+ (extent-end-position value)) 'utf-8)))))
+ ((and (consp value)
+ (markerp (car value))
+ (markerp (cdr value)))
+ (or (eq (marker-buffer (car value)) (marker-buffer (cdr value)))
+ (signal 'error
+ (list "markers must be in the same buffer"
+ (car value) (cdr value))))
+ (save-excursion
+ (set-buffer (or (marker-buffer (car value))
+ (error "selection is in a killed buffer")))
+ (save-restriction
+ (widen)
+ (cons 'UTF8_STRING (encode-coding-string
+ (buffer-substring (car value) (cdr value))
+ 'utf-8)))))
+ (t nil)))
+
(defun select-coerce-to-text (selection type value)
(select-convert-to-text selection type value))
-(defun select-convert-from-text (selection type value)
- (when (stringp value)
- value))
-
(defun select-convert-to-string (selection type value)
(let ((outval (select-convert-to-text selection type value)))
;; force the string to be not in Compound Text format. This grubby
＠＠ -477,9 +549,6 ＠＠
(cons (ash value -16) (logand value 65535))
nil)))
-(defun select-convert-from-length (selection type value)
- (select-convert-to-length selection type value))
-
(defun select-convert-to-targets (selection type value)
;; return a vector of atoms, but remove duplicates first.
(let* ((all (cons 'TIMESTAMP (mapcar 'car selection-converter-alist)))
＠＠ -509,10 +578,6 ＠＠
(error "selection is in a killed buffer"))))
(t nil)))
-(defun select-convert-from-filename (selection type value)
- (when (stringp value)
- value))
-
(defun select-convert-to-charpos (selection type value)
(let (a b tmp)
(cond ((cond ((extentp value)
＠＠ -682,35 +747,89 ＠＠
(t nil)
))
+(defun select-convert-from-ip-address (selection type value)
+ (if (and (stringp value)
+ (= (length value) 4))
+ (format "%d.%d.%d.%d"
+ (aref value 0) (aref value 1) (aref value 2) (aref value 3))))
+
(defun select-convert-to-atom (selection type value)
(and (symbolp value) value))
+(defun select-convert-from-utf-8-text (selection type value)
+ (decode-coding-string value 'utf-8))
+
+(defun select-convert-from-utf-16-le-text (selection type value)
+ (decode-coding-string value 'utf-16-le))
+
+;; Image conversion.
+(defun select-convert-from-image-data (image-type value)
+ "Take an image type specification--one of the image types this XEmacs
+supports--and some data in that format, return a space, with a glyph
+corresponding to that data as an end-glyph extent property of that space. "
+ (let* ((str (make-string 1 ?\ ))
+ (extent (make-extent 0 1 str))
+ (glyph (make-glyph (vector image-type ':data value))))
+ (when glyph
+ (set-extent-property extent 'invisible t)
+ (set-extent-property extent 'start-open t)
+ (set-extent-property extent 'end-open t)
+ (set-extent-property extent 'duplicable t)
+ (set-extent-property extent 'atomic t)
+ (set-extent-end-glyph extent glyph)
+ str)))
+
+;; Could automate defining these functions these with a macro, but damned if
+;; I can get that to work. Anyway, this is more readable.
+
+(defun select-convert-from-image/gif (selection type value)
+ (if (featurep 'gif) (select-convert-from-image-data 'gif value)))
+
+(defun select-convert-from-image/jpeg (selection type value)
+ (if (featurep 'jpeg) (select-convert-from-image-data 'jpeg value)))
+
+(defun select-convert-from-image/png (selection type value)
+ (if (featurep 'png) (select-convert-from-image-data 'png value)))
+
+(defun select-convert-from-image/tiff (selection type value)
+ (if (featurep 'tiff) (select-convert-from-image-data 'tiff value)))
+
+(defun select-convert-from-image/xpm (selection type value)
+ (if (featurep 'xpm) (select-convert-from-image-data 'xpm value)))
+
+(defun select-convert-from-image/xbm (selection type value)
+ (if (featurep 'xbm) (select-convert-from-image-data 'xbm value)))
+
;;; CF_xxx conversions
(defun select-convert-from-cf-text (selection type value)
- (let ((value (decode-coding-string value 'mswindows-multibyte)))
- (replace-in-string (if (string-match "\0" value)
- (substring value 0 (match-beginning 0))
- value)
- "\\(\r\n\\|\n\r\\)" "\n" t)))
+ (if (find-coding-system 'mswindows-multibyte)
+ (let ((value (decode-coding-string value 'mswindows-multibyte)))
+ (replace-in-string (if (string-match "\0" value)
+ (substring value 0 (match-beginning 0))
+ value)
+ "\\(\r\n\\|\n\r\\)" "\n" t))))
(defun select-convert-from-cf-unicodetext (selection type value)
- (let ((value (decode-coding-string value 'mswindows-unicode)))
- (replace-in-string (if (string-match "\0" value)
- (substring value 0 (match-beginning 0))
- value)
- "\\(\r\n\\|\n\r\\)" "\n" t)))
+ (if (find-coding-system 'mswindows-unicode)
+ (let ((value (decode-coding-string value 'mswindows-unicode)))
+ (replace-in-string (if (string-match "\0" value)
+ (substring value 0 (match-beginning 0))
+ value)
+ "\\(\r\n\\|\n\r\\)" "\n" t))))
(defun select-convert-to-cf-text (selection type value)
- (let ((text (select-convert-to-text selection type value)))
- (encode-coding-string
- (concat (replace-in-string text "\n" "\r\n" t) "\0")
- 'mswindows-multibyte)))
+ (if (find-coding-system 'mswindows-multibyte)
+ (let ((text (select-convert-to-text selection type value)))
+ (encode-coding-string
+ (concat (replace-in-string text "\n" "\r\n" t) "\0")
+ 'mswindows-multibyte))))
(defun select-convert-to-cf-unicodetext (selection type value)
- (let ((text (select-convert-to-text selection type value)))
- (encode-coding-string
- (concat (replace-in-string text "\n" "\r\n" t) "\0")
- 'mswindows-unicode)))
+ (if (find-coding-system 'mswindows-unicode)
+ (let ((text (select-convert-to-text selection type value)))
+ (encode-coding-string
+ (concat (replace-in-string text "\n" "\r\n" t) "\0")
+ 'mswindows-unicode))))
;;; Appenders
(defun select-append-to-text (selection type value1 value2)
＠＠ -788,7 +907,9 ＠＠
;; Types listed in here can be selections of XEmacs
(setq selection-converter-out-alist
- '((TEXT . select-convert-to-text)
+ '((TIMESTAMP . select-convert-to-timestamp)
+ (UTF8_STRING . select-convert-to-utf-8-text)
+ (TEXT . select-convert-to-text)
(STRING . select-convert-to-string)
(COMPOUND_TEXT . select-convert-to-compound-text)
(TARGETS . select-convert-to-targets)
＠＠ -813,21 +934,28 ＠＠
;; Types listed here can be selections foreign to XEmacs
(setq selection-converter-in-alist
'(; Specific types that get handled by generic converters
- (COMPOUND_TEXT . select-convert-from-text)
- (SOURCE_LOC . select-convert-from-text)
- (OWNER_OS . select-convert-from-text)
- (HOST_NAME . select-convert-from-text)
- (USER . select-convert-from-text)
- (CLASS . select-convert-from-text)
- (NAME . select-convert-from-text)
- ; Generic types
(INTEGER . select-convert-from-integer)
- (TEXT . select-convert-from-text)
- (STRING . select-convert-from-text)
- (LENGTH . select-convert-from-length)
- (FILE_NAME . select-convert-from-filename)
+ (TIMESTAMP . select-convert-from-integer)
+ (LENGTH . select-convert-from-integer)
+ (LIST_LENGTH . select-convert-from-integer)
+ (CLIENT_WINDOW . select-convert-from-integer)
+ (PROCESS . select-convert-from-integer)
+ (IP_ADDRESS . select-convert-from-ip-address)
+ ;; We go after UTF8_STRING in preference to STRING because Mozilla,
+ ;; at least, does bad things with non-Latin-1 Unicode characters in
+ ;; STRING.
+ (UTF8_STRING . select-convert-from-utf-8-text)
(CF_TEXT . select-convert-from-cf-text)
(CF_UNICODETEXT . select-convert-from-cf-unicodetext)
+ (text/html . select-convert-from-utf-16-le-text) ; Mozilla
+ (text/_moz_htmlcontext . select-convert-from-utf-16-le-text)
+ (text/_moz_htmlinfo . select-convert-from-utf-16-le-text)
+ (image/png . select-convert-from-image/png)
+ (image/gif . select-convert-from-image/gif)
+ (image/jpeg . select-convert-from-image/jpeg )
+ (image/tiff . select-convert-from-image/tiff )
+ (image/xpm . select-convert-from-image/xpm)
+ (image/xbm . select-convert-from-image/xbm)
))
;; Types listed here have special coercion functions that can munge
Index: lisp/x-select.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-select.el,v
retrieving revision 1.7
diff -u -u -r1.7 x-select.el
--- lisp/x-select.el 2001/05/04 22:42:18 1.7
+++ lisp/x-select.el 2005/02/26 20:43:00
＠＠ -43,7 +43,7 ＠＠
(define-obsolete-function-alias 'x-selection-owner-p 'selection-owner-p)
(define-obsolete-variable-alias 'x-selection-converter-alist 'selection-converter-alist)
(define-obsolete-variable-alias 'x-lost-selection-hooks 'lost-selection-hooks)
-(define-obsolete-variable-alias 'x-selected-text-type 'selected-text-type)
+(define-obsolete-variable-alias 'x-selected-text-type 'selection-preferred-types)
(define-obsolete-function-alias 'x-valid-simple-selection-p 'valid-simple-selection-p)
(define-obsolete-function-alias 'x-own-selection 'own-selection)
(define-obsolete-function-alias 'x-disown-selection 'disown-selection)
Index: src/select-gtk.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/select-gtk.c,v
retrieving revision 1.16
diff -u -u -r1.16 select-gtk.c
--- src/select-gtk.c 2004/11/04 23:06:52 1.16
+++ src/select-gtk.c 2005/02/26 20:43:00
＠＠ -158,7 +158,7 ＠＠
target_symbol = fetch_multiple_target (selection_data);
#endif
- temp_obj = Fget_selection_timestamp (selection_symbol);
+ temp_obj = get_selection_raw_time(selection_symbol);
if (NILP (temp_obj))
{
＠＠ -255,7 +255,7 ＠＠
selection_symbol = atom_to_symbol (d, selection);
- local_selection_time_lisp = Fget_selection_timestamp (selection_symbol);
+ local_selection_time_lisp = get_selection_raw_time (selection_symbol);
/* We don't own the selection, so that's fine. */
if (NILP (local_selection_time_lisp))
＠＠ -428,13 +428,14 ＠＠
selection_atom,
thyme);
- /* We do NOT use time_to_lisp() here any more, like we used to.
+ /* [[ We do NOT use time_to_lisp() here any more, like we used to.
That assumed equivalence of time_t and Time, which is not
necessarily the case (e.g. under OSF on the Alphas, where
Time is a 64-bit quantity and time_t is a 32-bit quantity).
- Opaque pointers are the clean way to go here.
- */
+ Opaque pointers are the clean way to go here. ]]
+
+ See my comment on the same issue in select-x.c -- Aidan. */
return make_opaque (&thyme, sizeof (thyme));
}
Index: src/select-x.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/select-x.c,v
retrieving revision 1.17
diff -u -u -r1.17 select-x.c
--- src/select-x.c 2005/01/24 23:34:09 1.17
+++ src/select-x.c 2005/02/26 20:43:01
＠＠ -237,13 +237,21 ＠＠
XSetSelectionOwner (display, selection_atom, selecting_window, thyme);
- /* We do NOT use time_to_lisp() here any more, like we used to.
+ /* [[ We do NOT use time_to_lisp() here any more, like we used to.
That assumed equivalence of time_t and Time, which is not
necessarily the case (e.g. under OSF on the Alphas, where
- Time is a 64-bit quantity and time_t is a 32-bit quantity).
+ Time is a 64-bit quantity and time_t is a 32-bit quantity).]]
- Opaque pointers are the clean way to go here.
- */
+ This is wrong--on Digital Unix, time_t is a sixty-four-bit quantity,
+ and Time is, as the X protocol dictates, a thirty-two-bit quantity.
+
+ [[ Opaque pointers are the clean way to go here. ]]
+
+ Again, I disagree--the Lisp selection infrastructure needs to be
+ able to manipulate the selection timestamps if it is, as we want
+ it to, to be able to do most of the work. Though I have moved the
+ conversion to lisp to get-xemacs-selection-timestamp. -- Aidan. */
+
selection_time = make_opaque (&thyme, sizeof (thyme));
#ifdef MOTIF_CLIPBOARDS
＠＠ -605,7 +613,7 ＠＠
target_symbol = fetch_multiple_target (event);
#endif
- temp_obj = Fget_selection_timestamp (selection_symbol);
+ temp_obj = get_selection_raw_time (selection_symbol);
if (NILP (temp_obj))
{
＠＠ -653,7 +661,12 ＠＠
successful_p = Qt;
/* Tell x_selection_request_lisp_error() it's cool. */
event->type = 0;
- xfree (data, Rawbyte *);
+ /* Data need not have been allocated; cf. select-convert-to-delete in
+ lisp/select.el . */
+ if ((Rawbyte *)0 != data)
+ {
+ xfree (data, Rawbyte *);
+ }
}
unbind_to (count);
＠＠ -693,7 +706,7 ＠＠
selection_symbol = x_atom_to_symbol (d, selection);
- local_selection_time_lisp = Fget_selection_timestamp (selection_symbol);
+ local_selection_time_lisp = get_selection_raw_time (selection_symbol);
/* We don't own the selection, so that's fine. */
if (NILP (local_selection_time_lisp))
Index: src/select.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/select.c,v
retrieving revision 1.6
diff -u -u -r1.6 select.c
--- src/select.c 2002/06/20 21:18:45 1.6
+++ src/select.c 2005/02/26 20:43:02
＠＠ -289,6 +289,14 ＠＠
/* have to do device specific stuff last so that methods can access the
selection_alist */
+
+ /* If you are re-implementing this for another redisplay type, either make
+ certain that the selection time will fit within thirty-two bits, or
+ redesign get-xemacs-selection-timestamp to return, say, a bignum, and
+ convert the device-specific timestamp to a bignum before storing it in
+ this list. The current practice is to blindly assume that the timestamp
+ is thirty-two bits, which will work for extant architectures. */
+
if (HAS_DEVMETH_P (XDEVICE (device), own_selection))
selection_time = DEVMETH (XDEVICE (device), own_selection,
(selection_name, selection_value,
＠＠ -492,18 +500,36 ＠＠
: Qnil;
}
+Lisp_Object
+get_selection_raw_time(Lisp_Object selection)
+{
+ Lisp_Object local_value = assq_no_quit (selection, Vselection_alist);
+
+ if (!NILP (local_value))
+ {
+ return XCAR (XCDR (XCDR (local_value)));
+ }
+ return Qnil;
+}
+
/* Get the timestamp of the given selection */
-DEFUN ("get-selection-timestamp", Fget_selection_timestamp, 1, 1, 0, /*
-Return the timestamp associated with the specified SELECTION, if it exists.
-Note that the timestamp is a device-specific object, and may not actually be
-visible from Lisp.
+DEFUN ("get-xemacs-selection-timestamp", Fget_selection_timestamp, 1, 1, 0, /*
+Return timestamp for SELECTION, if belongs to XEmacs and exists.
+
+The timestamp is a cons of two integers, the first being the higher-order
+sixteen bits of the device-specific thirty-two-bit quantity, the second
+being the lower-order sixteen bits of same. Expect to see this API change
+when and if redisplay on a window system with timestamps wider than 32bits
+happens.
*/
(selection))
{
- Lisp_Object local_value = assq_no_quit (selection, Vselection_alist);
+ Lisp_Object val = get_selection_raw_time(selection);
- if (!NILP (local_value))
- return XCAR (XCDR (XCDR (local_value)));
+ if (!NILP (val))
+ {
+ return word_to_lisp(* (UINT_32_BIT *) XOPAQUE_DATA (val));
+ }
return Qnil;
}
Index: src/select.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/select.h,v
retrieving revision 1.2
diff -u -u -r1.2 select.h
--- src/select.h 2001/04/12 18:24:19 1.2
+++ src/select.h 2005/02/26 20:43:02
＠＠ -57,12 +57,13 ＠＠
void select_notify_buffer_kill (Lisp_Object buffer);
+Lisp_Object get_selection_raw_time(Lisp_Object selection);
+
/* Lisp functions we export for other files' use */
EXFUN (Fregister_selection_data_type, 2);
EXFUN (Fselection_data_type_name, 2);
EXFUN (Favailable_selection_types, 2);
EXFUN (Fselection_owner_p, 1);
EXFUN (Fselection_exists_p, 3);
-EXFUN (Fget_selection_timestamp, 1);
#endif /* INCLUDED_select_h_ */
--
“I, for instance, am gung-ho about open source because my family is being
held hostage in Rob Malda’s basement. But who fact-checks me, or Enderle,
when we say something in public? No-one!” -- Danny O’Brien
- 1 participants
- 1 comments
Symantec Mail Security detected prohibited content in a message sent from your address (SYM:42033868363467168192)
19 years, 7 months
symantec＠ben.edu
symantec＠ben.edu
Subject of the message: Re: Word file
Recipient of the message: "employeeservices(a)ben.edu" <employeeservices(a)ben.edu>
- 1 participants
- 0 comments