annotate src/dragdrop.c @ 4792:95b04754ea8c

Make #'equalp more compatible with CL; add a compiler macro, test & doc it. lisp/ChangeLog addition: 2009-11-08 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (cl-string-vector-equalp) (cl-bit-vector-vector-equalp, cl-vector-array-equalp) (cl-hash-table-contents-equalp): New functions, to implement equalp treating arrays with identical contents as equivalent, as specified by Common Lisp. (equalp): Revise this function to implement array equivalence, and the hash-table equalp behaviour specified by CL. * cl-macs.el (equalp): Add a compiler macro for this function, used when one of the arguments is constant, and as such, its type is known at compile time. man/ChangeLog addition: 2009-11-08 Aidan Kehoe <kehoea@parhasard.net> * lispref/objects.texi (Equality Predicates): Document #'equalp here, as well as #'equal and #'eq. tests/ChangeLog addition: 2009-12-31 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: Test much of the functionality of equalp; add a pointer to Paul Dietz' ANSI test suite for this function, converted to Emacs Lisp. Not including the tests themselves in XEmacs because who owns the copyright on the files is unclear and the GCL people didn't respond to my queries.
author Aidan Kehoe <kehoea@parhasard.net>
date Thu, 31 Dec 2009 15:09:41 +0000
parents bc4f2511bbea
children 308d34e9f07d
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* Drag'n'Drop definitions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 created 03-may-98 by Oliver Graf <ograf@fga.de>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 Copyright (C) 1998 Oliver Graf <ograf@fga.de>
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 563
diff changeset
4 Copyright (C) 2004 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 /* Synched up with: Not in FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 /* This file should be Mule-ized. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 /* A short introduction to the new Drag'n'Drop Model:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 A drop generates a extended misc-user-event, as defined in events.[ch].
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 This event contains the same as a eval and a button event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 The function of a drop is set to 'dragdrop-drop-dispatch' which will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 defined in ../lisp/dragdrop.el.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 The object of the misc-user-event has the following format:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 ( TYPE . DATA )
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2367
diff changeset
35 TYPE is one of `dragdrop-MIME' and `dragdrop-URL'
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2367
diff changeset
36 DATA - if TYPE is `dragdrop-URL', DATA is a list of valid URL strings. It
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 is always a list, also if only one URL string is within it.
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2367
diff changeset
38 - if TYPE is `dragdrop-MIME', DATA is a list of MIME elements.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 Each can be a string or a list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 if it is a string it is the pure MIME data complete with header
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 and body.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 if it is a list it should look like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 ( MIME-TYPE MIME-ENCODING MIME-DATA )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 MIME-TYPE list of type and key.value conses. Same as in tm-view
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 MIME-ENC the same (a string in this case)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 MIME-DATA is a string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 #include "dragdrop.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 /* The supported protocol list */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 Lisp_Object Vdragdrop_protocols;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 /* Drag'n'Drop data types known by XEmacs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 Lisp_Object Qdragdrop_MIME;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 Lisp_Object Qdragdrop_URL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 /* External defined functions to handle Drag'n'Drop */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 Lisp_Object Qdragdrop_drop_dispatch;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 /* from wget -- thanxx Hrvoje */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 /* A list of unsafe characters for encoding, as per RFC1738. '@' and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 ':' (not listed in RFC) were added because of user/password
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 encoding, and \033 for safe printing. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 #define URL_UNSAFE " <>\"#%{}|\\^~[]`@:\033"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 /* HEX digit -> ASCII char */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 #define HEXD2ASC(x) (((x) < 10) ? ((x) + '0') : ((x) - 10 + 'A'))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 /* Encodes the unsafe characters (listed in URL_UNSAFE) in a given
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 string, returning a malloc-ed %XX encoded string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 if method is != NULL it is prepended to the string. */
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 563
diff changeset
76 Ibyte *
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 563
diff changeset
77 dnd_url_hexify_string (const Ibyte *s, const Ibyte *m)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 {
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 563
diff changeset
79 const Ibyte *b;
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 563
diff changeset
80 Ibyte *p, *res;
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 563
diff changeset
81 Bytecount i;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 b = s;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 for (i = 0; *s; s++, i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 if (strchr (URL_UNSAFE, *s))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 i += 2; /* Two more characters (hex digits) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 if (m)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 {
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 563
diff changeset
89 res = xnew_ibytes (i + ITEXT_ZTERM_SIZE + qxestrlen (m));
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 563
diff changeset
90 qxestrcpy (res, m);
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 563
diff changeset
91 p = res + qxestrlen (m);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 {
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 563
diff changeset
95 res = xnew_ibytes (i + ITEXT_ZTERM_SIZE);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 p = res;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 for (s = b; *s; s++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 if (strchr (URL_UNSAFE, *s))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 {
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 563
diff changeset
101 const Ibyte c = *s;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 *p++ = '%';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 *p++ = HEXD2ASC (c >> 4);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 *p++ = HEXD2ASC (c & 0xf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 *p++ = *s;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 *p = '\0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 return res;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 syms_of_dragdrop (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
115 DEFSYMBOL (Qdragdrop_MIME);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
116 DEFSYMBOL (Qdragdrop_URL);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
117 DEFSYMBOL (Qdragdrop_drop_dispatch);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 vars_of_dragdrop (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 Fprovide (intern ("dragdrop-api"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 DEFVAR_CONST_LISP ("dragdrop-protocols", &Vdragdrop_protocols /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 A list of supported Drag'n'drop protocols.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 Each element is the feature symbol of the protocol.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 Vdragdrop_protocols = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 #ifdef HAVE_MS_WINDOWS
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 563
diff changeset
133 Vdragdrop_protocols = Fcons (Qmswindows, Vdragdrop_protocols);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 #ifdef HAVE_CDE
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 563
diff changeset
136 Vdragdrop_protocols = Fcons (intern ("cde"), Vdragdrop_protocols);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 #endif
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 428
diff changeset
138 #ifdef HAVE_GTK
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 563
diff changeset
139 Vdragdrop_protocols = Fcons (Qgtk, Vdragdrop_protocols);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 428
diff changeset
140 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 }