/[emacs]/emacs/lisp/select.el
ViewVC logotype

Diff of /emacs/lisp/select.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.17 by eliz, Wed Jun 5 17:14:16 2002 UTC revision 1.17.2.1 by miles, Fri Apr 4 06:20:10 2003 UTC
# Line 31  Line 31 
31  (defalias 'x-selection 'x-get-selection)  (defalias 'x-selection 'x-get-selection)
32  (defun x-get-selection (&optional type data-type)  (defun x-get-selection (&optional type data-type)
33    "Return the value of an X Windows selection.    "Return the value of an X Windows selection.
34  The argument TYPE (default `PRIMARY') says which selection,  The argument TYPE (default `PRIMARY') says which selection,
35  and the argument DATA-TYPE (default `STRING') says  and the argument DATA-TYPE (default `STRING') says
36  how to convert the data.  how to convert the data.
37    
# Line 46  in `selection-converter-alist', which se Line 46  in `selection-converter-alist', which se
46    
47  (defun x-set-selection (type data)  (defun x-set-selection (type data)
48    "Make an X Windows selection of type TYPE and value DATA.    "Make an X Windows selection of type TYPE and value DATA.
49  The argument TYPE (default `PRIMARY') says which selection,  The argument TYPE (default `PRIMARY') says which selection,
50  and DATA specifies the contents.  DATA may be a string,  and DATA specifies the contents.  DATA may be a string,
51  a symbol, an integer (or a cons of two integers or list of two integers).  a symbol, an integer (or a cons of two integers or list of two integers).
52    
53  The selection may also be a cons of two markers pointing to the same buffer,  The selection may also be a cons of two markers pointing to the same buffer,
54  or an overlay.  In these cases, the selection is considered to be the text  or an overlay.  In these cases, the selection is considered to be the text
55  between the markers *at whatever time the selection is examined*.  between the markers *at whatever time the selection is examined*.
56  Thus, editing done in the buffer after you specify the selection  Thus, editing done in the buffer after you specify the selection
57  can alter the effective value of the selection.  can alter the effective value of the selection.
# Line 118  Cut buffers are considered obsolete; you Line 118  Cut buffers are considered obsolete; you
118  (defun x-set-cut-buffer (string &optional push)  (defun x-set-cut-buffer (string &optional push)
119    "Store STRING into the X server's primary cut buffer.    "Store STRING into the X server's primary cut buffer.
120  If PUSH is non-nil, also rotate the cut buffers:  If PUSH is non-nil, also rotate the cut buffers:
121  this means the previous value of the primary cut buffer moves the second  this means the previous value of the primary cut buffer moves to the second
122  cut buffer, and the second to the third, and so on (there are 8 buffers.)  cut buffer, and the second to the third, and so on (there are 8 buffers.)
123  Cut buffers are considered obsolete; you should use selections instead."  Cut buffers are considered obsolete; you should use selections instead."
124    ;; Check the data type of STRING.    (or (stringp string) (signal 'wrong-type-argument (list 'string string)))
   (substring string 0 0)  
125    (if push    (if push
126        (x-rotate-cut-buffers-internal 1))        (x-rotate-cut-buffers-internal 1))
127    (x-store-cut-buffer-internal 'CUT_BUFFER0 string))    (x-store-cut-buffer-internal 'CUT_BUFFER0 string))
# Line 133  Cut buffers are considered obsolete; you Line 132  Cut buffers are considered obsolete; you
132  ;;; for TIMESTAMP, which is a special case.  ;;; for TIMESTAMP, which is a special case.
133    
134  (defun xselect-convert-to-string (selection type value)  (defun xselect-convert-to-string (selection type value)
135    (cond ((stringp value)    (let (str coding)
136           ;; Return the type as well, so that xselect.c could honor      ;; Get the actual string from VALUE.
137           ;; requests whose type is STRING.      (cond ((stringp value)
138           (cons type value))             (setq str value))
139          ((overlayp value)  
140           (save-excursion            ((overlayp value)
141             (or (buffer-name (overlay-buffer value))             (save-excursion
142                 (error "selection is in a killed buffer"))               (or (buffer-name (overlay-buffer value))
143             (set-buffer (overlay-buffer value))                   (error "selection is in a killed buffer"))
144             (buffer-substring (overlay-start value)               (set-buffer (overlay-buffer value))
145                               (overlay-end value))))               (setq str (buffer-substring (overlay-start value)
146          ((and (consp value)                                           (overlay-end value)))))
147                (markerp (car value))            ((and (consp value)
148                (markerp (cdr value)))                  (markerp (car value))
149           (or (eq (marker-buffer (car value)) (marker-buffer (cdr value)))                  (markerp (cdr value)))
150               (signal 'error             (or (eq (marker-buffer (car value)) (marker-buffer (cdr value)))
151                       (list "markers must be in the same buffer"                 (signal 'error
152                             (car value) (cdr value))))                         (list "markers must be in the same buffer"
153           (save-excursion                               (car value) (cdr value))))
154             (set-buffer (or (marker-buffer (car value))             (save-excursion
155                             (error "selection is in a killed buffer")))               (set-buffer (or (marker-buffer (car value))
156             (buffer-substring (car value) (cdr value))))                               (error "selection is in a killed buffer")))
157          (t nil)))               (setq str (buffer-substring (car value) (cdr value))))))
158    
159        (when str
160          ;; If TYPE is nil, this is a local request, thus return STR as
161          ;; is.  Otherwise, encode STR.
162          (if (not type)
163              str
164            (setq coding (or next-selection-coding-system selection-coding-system))
165            (if coding
166                (setq coding (coding-system-base coding))
167              (setq coding 'raw-text))
168            ;; Suppress producing escape sequences for compositions.
169            (remove-text-properties 0 (length str) '(composition nil) str)
170            (cond
171             ((eq type 'TEXT)
172              (if (not (multibyte-string-p str))
173                  ;; Don't have to encode unibyte string.
174                  (setq type 'STRING)
175                ;; If STR contains only ASCII, Latin-1, and raw bytes,
176                ;; encode STR by iso-latin-1, and return it as type
177                ;; `STRING'.  Otherwise, encode STR by CODING.  In that
178                ;; case, the returing type depends on CODING.
179                (let ((charsets (find-charset-string str)))
180                  (setq charsets
181                        (delq 'ascii
182                              (delq 'latin-iso8859-1
183                                    (delq 'eight-bit-control
184                                          (delq 'eight-bit-graphic charsets)))))
185                  (if charsets
186                      (setq str (encode-coding-string str coding)
187                            type (if (memq coding '(compound-text
188                                                    compound-text-with-extensions))
189                                     'COMPOUND_TEXT
190                                   'STRING))
191                    (setq type 'STRING
192                          str (encode-coding-string str 'iso-latin-1))))))
193    
194             ((eq type 'COMPOUND_TEXT)
195              (setq str (encode-coding-string str coding)))
196    
197             ((eq type 'STRING)
198              (if (memq coding '(compound-text
199                                 compound-text-with-extensions))
200                  (setq str (string-make-unibyte str))
201                (setq str (encode-coding-string str coding))))
202    
203             ((eq type 'UTF8_STRING)
204              (setq str (encode-coding-string str 'utf-8)))
205    
206             (t
207              (error "Unknow selection type: %S" type))
208             ))
209    
210          (setq next-selection-coding-system nil)
211          (cons type str))))
212    
213    
214  (defun xselect-convert-to-length (selection type value)  (defun xselect-convert-to-length (selection type value)
215    (let ((value    (let ((value
# Line 304  This function returns the string \"emacs Line 358  This function returns the string \"emacs
358        '((TEXT . xselect-convert-to-string)        '((TEXT . xselect-convert-to-string)
359          (COMPOUND_TEXT . xselect-convert-to-string)          (COMPOUND_TEXT . xselect-convert-to-string)
360          (STRING . xselect-convert-to-string)          (STRING . xselect-convert-to-string)
361            (UTF8_STRING . xselect-convert-to-string)
362          (TARGETS . xselect-convert-to-targets)          (TARGETS . xselect-convert-to-targets)
363          (LENGTH . xselect-convert-to-length)          (LENGTH . xselect-convert-to-length)
364          (DELETE . xselect-convert-to-delete)          (DELETE . xselect-convert-to-delete)

Legend:
Removed from v.1.17  
changed lines
  Added in v.1.17.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26