Mercurial > hg > xemacs-beta

comparison lisp/select.el @ 5571:5273dd66a1ba

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Strip extent information when passing text to external programs, select.el lisp/ChangeLog addition: 2011-09-21 Aidan Kehoe <kehoea@parhasard.net> * select.el (select-convert-to-text): * select.el (select-convert-to-utf-8-text): Ignore extent information in these functions, other programs can't do anything useful with it, and it actively interferes when copying from an ERC buffer to external programs-- #'encode-coding-string complains that the string is read-only, which is arguably in itself a separate problem, since it allocates a new string there's no reason for it ever to throw that error.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 21 Sep 2011 19:14:15 +0100
parents ac37a5f7e5be
children cc1ec4c93a67
comparison
equal deleted inserted replaced
5570:6c76f5b7e2e3 5571:5273dd66a1ba
454 454
455 ;; The rest of the functions on this "page" are conversion handlers, 455 ;; The rest of the functions on this "page" are conversion handlers,
456 ;; append handlers and buffer-kill handlers. 456 ;; append handlers and buffer-kill handlers.
457 (defun select-convert-to-text (selection type value) 457 (defun select-convert-to-text (selection type value)
458 (cond ((stringp value) 458 (cond ((stringp value)
459 value) 459 (substring-no-properties value))
460 ((extentp value) 460 ((extentp value)
461 (save-excursion 461 (save-excursion
462 (set-buffer (extent-object value)) 462 (set-buffer (extent-object value))
463 (save-restriction 463 (save-restriction
464 (widen) 464 (widen)
465 (buffer-substring (extent-start-position value) 465 (buffer-substring-no-properties (extent-start-position value)
466 (extent-end-position value))))) 466 (extent-end-position value)))))
467 ((and (consp value) 467 ((and (consp value)
468 (markerp (car value)) 468 (markerp (car value))
469 (markerp (cdr value))) 469 (markerp (cdr value)))
470 (or (eq (marker-buffer (car value)) (marker-buffer (cdr value))) 470 (or (eq (marker-buffer (car value)) (marker-buffer (cdr value)))
471 (signal 'error 471 (signal 'error
474 (save-excursion 474 (save-excursion
475 (set-buffer (or (marker-buffer (car value)) 475 (set-buffer (or (marker-buffer (car value))
476 (error "selection is in a killed buffer"))) 476 (error "selection is in a killed buffer")))
477 (save-restriction 477 (save-restriction
478 (widen) 478 (widen)
479 (buffer-substring (car value) (cdr value))))) 479 (buffer-substring-no-properties (car value) (cdr value)))))
480 (t nil))) 480 (t nil)))
481 481
482 (defun select-convert-to-timestamp (selection type value) 482 (defun select-convert-to-timestamp (selection type value)
483 (let ((ts (get-xemacs-selection-timestamp selection))) 483 (let ((ts (get-xemacs-selection-timestamp selection)))
484 (if ts (cons 'TIMESTAMP ts)))) 484 (if ts (cons 'TIMESTAMP ts))))
485 485
486 (defun select-convert-to-utf-8-text (selection type value) 486 (defun select-convert-to-utf-8-text (selection type value)
487 (cond ((stringp value) 487 (cond ((stringp value)
488 (cons 'UTF8_STRING (encode-coding-string value 'utf-8))) 488 (cons 'UTF8_STRING (encode-coding-string
489 (substring-no-properties value) 'utf-8)))
489 ((extentp value) 490 ((extentp value)
490 (save-excursion 491 (save-excursion
491 (set-buffer (extent-object value)) 492 (set-buffer (extent-object value))
492 (save-restriction 493 (save-restriction
493 (widen) 494 (widen)
494 (cons 'UTF8_STRING 495 (cons 'UTF8_STRING
495 (encode-coding-string 496 (encode-coding-string (buffer-substring-no-properties
496 (buffer-substring (extent-start-position value) 497 (extent-start-position value)
497 (extent-end-position value)) 'utf-8))))) 498 (extent-end-position value))
499 'utf-8)))))
498 ((and (consp value) 500 ((and (consp value)
499 (markerp (car value)) 501 (markerp (car value))
500 (markerp (cdr value))) 502 (markerp (cdr value)))
501 (or (eq (marker-buffer (car value)) (marker-buffer (cdr value))) 503 (or (eq (marker-buffer (car value)) (marker-buffer (cdr value)))
502 (signal 'error 504 (signal 'error
506 (set-buffer (or (marker-buffer (car value)) 508 (set-buffer (or (marker-buffer (car value))
507 (error "selection is in a killed buffer"))) 509 (error "selection is in a killed buffer")))
508 (save-restriction 510 (save-restriction
509 (widen) 511 (widen)
510 (cons 'UTF8_STRING (encode-coding-string 512 (cons 'UTF8_STRING (encode-coding-string
511 (buffer-substring (car value) (cdr value)) 513 (buffer-substring-no-properties
512 'utf-8))))) 514 (car value) (cdr value)) 'utf-8)))))
513 (t nil))) 515 (t nil)))
514 516
515 (defun select-coerce-to-text (selection type value) 517 (defun select-coerce-to-text (selection type value)
516 (select-convert-to-text selection type value)) 518 (select-convert-to-text selection type value))
517 519