/[emacs]/emacs/lisp/term/x-win.el
ViewVC logotype

Diff of /emacs/lisp/term/x-win.el

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

revision 1.153 by jhd, Tue Mar 12 21:15:07 2002 UTC revision 1.154 by pj, Wed Apr 24 13:17:08 2002 UTC
# Line 1  Line 1 
1  ;;; x-win.el --- parse switches controlling interface with X window system  ;;; x-win.el --- parse switches controlling interface with X window system
2    
3  ;; Copyright (C) 1993, 1994, 2001 Free Software Foundation, Inc.  ;; Copyright (C) 1993, 1994, 2001, 2002 Free Software Foundation, Inc.
4    
5  ;; Author: FSF  ;; Author: FSF
6  ;; Keywords: terminals  ;; Keywords: terminals
# Line 1266  as returned by (x-server-vendor)." Line 1266  as returned by (x-server-vendor)."
1266    
1267  ;;; We keep track of the last text selected here, so we can check the  ;;; We keep track of the last text selected here, so we can check the
1268  ;;; current selection against it, and avoid passing back our own text  ;;; current selection against it, and avoid passing back our own text
1269  ;;; from x-cut-buffer-or-selection-value.  ;;; from x-cut-buffer-or-selection-value.  We track all three
1270  (defvar x-last-selected-text nil)  ;;; seperately in case another X application only sets one of them
1271    ;;; (say the the cut buffer) we aren't fooled by the PRIMARY or
1272    ;;; CLIPBOARD selection staying the same.
1273    (defvar x-last-selected-text-clipboard nil
1274      "The value of the CLIPBOARD X selection last time we selected or
1275    pasted text.")
1276    (defvar x-last-selected-text-primary   nil
1277      "The value of the PRIMARY X selection last time we selected or
1278    pasted text.")
1279    (defvar x-last-selected-text-cut       nil
1280      "The vaue of the X cut buffer last time we selected or
1281    pasted text.")
1282    
1283  ;;; It is said that overlarge strings are slow to put into the cut buffer.  ;;; It is said that overlarge strings are slow to put into the cut buffer.
1284  ;;; Note this value is overridden below.  ;;; Note this value is overridden below.
# Line 1288  This is in addition to, but in preferenc Line 1299  This is in addition to, but in preferenc
1299  (defun x-select-text (text &optional push)  (defun x-select-text (text &optional push)
1300    ;; Don't send the cut buffer too much text.    ;; Don't send the cut buffer too much text.
1301    ;; It becomes slow, and if really big it causes errors.    ;; It becomes slow, and if really big it causes errors.
1302    (if (< (length text) x-cut-buffer-max)    (cond ((>= (length text) x-cut-buffer-max)
1303             (x-set-cut-buffer "" push)
1304             (setq x-last-selected-text-cut ""))
1305            (t
1306        (x-set-cut-buffer text push)        (x-set-cut-buffer text push)
1307      (x-set-cut-buffer "" push))           (setq x-last-selected-text-cut text)))
1308    (x-set-selection 'PRIMARY text)    (x-set-selection 'PRIMARY text)
1309    (if x-select-enable-clipboard    (setq x-last-selected-text-primary text)
1310        (x-set-selection 'CLIPBOARD text))    (when x-select-enable-clipboard
1311    (setq x-last-selected-text text))        (x-set-selection 'CLIPBOARD text)
1312          (setq x-last-selected-text-clipboard text))
1313      )
1314    
1315  ;;; Return the value of the current X selection.  ;;; Return the value of the current X selection.
1316  ;;; Consult the selection, then the cut buffer.  Treat empty strings  ;;; Consult the selection, and the cut buffer.  Treat empty strings
1317  ;;; as if they were unset.  ;;; as if they were unset.
1318  ;;; If this function is called twice and finds the same text,  ;;; If this function is called twice and finds the same text,
1319  ;;; it returns nil the second time.  This is so that a single  ;;; it returns nil the second time.  This is so that a single
1320  ;;; selection won't be added to the kill ring over and over.  ;;; selection won't be added to the kill ring over and over.
1321  (defun x-cut-buffer-or-selection-value ()  (defun x-cut-buffer-or-selection-value ()
1322    (let (text)    (let (clip-text primary-text cut-text)
1323      (when x-select-enable-clipboard      (when x-select-enable-clipboard
1324        (if (null text)        ;; Don't die if x-get-selection signals an error.
1325          (if (null clip-text)
1326            (condition-case c            (condition-case c
1327                (setq text (x-get-selection 'CLIPBOARD 'COMPOUND_TEXT))                (setq clip-text (x-get-selection 'CLIPBOARD 'COMPOUND_TEXT))
1328              (error nil)))              (error nil)))
1329        (if (null text)        (if (null clip-text)
1330            (condition-case c            (condition-case c
1331                (setq text (x-get-selection 'CLIPBOARD 'STRING))                (setq clip-text (x-get-selection 'CLIPBOARD 'STRING))
1332              (error nil)))              (error nil)))
1333        (if (string= text "") (setq text nil)))        (if (string= clip-text "") (setq clip-text nil))
1334    
1335          ;; Check the CLIPBOARD selection for 'newness', is it different
1336          ;; from what we remebered them to be last time we did a
1337          ;; cut/paste operation.
1338          (setq clip-text
1339                (cond;; check clipboard
1340                 ((or (not clip-text) (string= clip-text ""))
1341                  (setq x-last-selected-text-clipboard nil))
1342                 ((eq      clip-text x-last-selected-text-clipboard) nil)
1343                 ((string= clip-text x-last-selected-text-clipboard)
1344                  ;; Record the newer string,
1345                  ;; so subsequent calls can use the `eq' test.
1346                  (setq x-last-selected-text-clipboard clip-text)
1347                  nil)
1348                 (t
1349                  (setq x-last-selected-text-clipboard clip-text))))
1350          )
1351    
1352      ;; Don't die if x-get-selection signals an error.      ;; Don't die if x-get-selection signals an error.
1353      (if (null text)      (if (null primary-text)
1354          (condition-case c          (condition-case c
1355              (setq text (x-get-selection 'PRIMARY 'COMPOUND_TEXT))              (setq primary-text (x-get-selection 'PRIMARY 'COMPOUND_TEXT))
1356            (error nil)))            (error nil)))
1357      (if (null text)      (if (null primary-text)
1358          (condition-case c          (condition-case c
1359              (setq text (x-get-selection 'PRIMARY 'STRING))              (setq primary-text (x-get-selection 'PRIMARY 'STRING))
1360            (error nil)))            (error nil)))
1361      (if (string= text "") (setq text nil))      ;; Check the PRIMARY selection for 'newness', is it different
1362        ;; from what we remebered them to be last time we did a
1363      (or text (setq text (x-get-cut-buffer 0)))      ;; cut/paste operation.
1364      (if (string= text "") (setq text nil))      (setq primary-text
1365              (cond;; check primary selection
1366      (cond             ((or (not primary-text) (string= primary-text ""))
1367       ((not text) nil)              (setq x-last-selected-text-primary nil))
1368       ((eq text x-last-selected-text) nil)             ((eq      primary-text x-last-selected-text-primary) nil)
1369       ((string= text x-last-selected-text)             ((string= primary-text x-last-selected-text-primary)
1370        ;; Record the newer string, so subsequent calls can use the `eq' test.              ;; Record the newer string,
1371        (setq x-last-selected-text text)              ;; so subsequent calls can use the `eq' test.
1372                (setq x-last-selected-text-primary primary-text)
1373                nil)
1374               (t
1375                (setq x-last-selected-text-primary primary-text))))
1376    
1377        (setq cut-text (x-get-cut-buffer 0))
1378    
1379        ;; Check the x cut buffer for 'newness', is it different
1380        ;; from what we remebered them to be last time we did a
1381        ;; cut/paste operation.
1382        (setq cut-text
1383              (cond;; check primary selection
1384               ((or (not cut-text) (string= cut-text ""))
1385                (setq x-last-selected-text-cut nil))
1386               ((eq      cut-text x-last-selected-text-cut) nil)
1387               ((string= cut-text x-last-selected-text-cut)
1388                ;; Record the newer string,
1389                ;; so subsequent calls can use the `eq' test.
1390                (setq x-last-selected-text-cut cut-text)
1391        nil)        nil)
1392       (t       (t
1393        (setq x-last-selected-text text)))))              (setq x-last-selected-text-cut cut-text))))
1394    
1395        ;; At this point we have recorded the current values for the
1396        ;; selection from clipboard (if we are supposed to) primary,
1397        ;; and cut buffer.  So return the first one that has changed
1398        ;; (which is the first non-null one).
1399        ;;
1400        ;; NOTE: There will be cases where more than one of these has
1401        ;; changed and the new values differ.  This indicates that
1402        ;; something like the following has happened since the last time
1403        ;; we looked at the selections: Application X set all the
1404        ;; selections, then Application Y set only one or two of them (say
1405        ;; just the cut-buffer).  In this case since we don't have
1406        ;; timestamps there is no way to know what the 'correct' value to
1407        ;; return is.  The nice thing to do would be to tell the user we
1408        ;; saw multiple possible selections and ask the user which was the
1409        ;; one they wanted.  
1410        ;; This code is still a big improvement because now the user can
1411        ;; futz with the current selection and get emacs to pay attention
1412        ;; to the cut buffer again (previously as soon as clipboard or
1413        ;; primary had been set the cut buffer would essentially never be
1414        ;; checked again).
1415        (or clip-text primary-text cut-text)
1416        ))
1417    
1418    
1419  ;;; Do the actual X Windows setup here; the above code just defines  ;;; Do the actual X Windows setup here; the above code just defines

Legend:
Removed from v.1.153  
changed lines
  Added in v.1.154

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