Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-misc.el @ 120:cca96a509cfe r20-1b12

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b12
author cvs
date Mon, 13 Aug 2007 09:25:29 +0200
parents 7d55a9ba150c
children 585fb297b004
comparison
equal deleted inserted replaced
119:d101af7320b8 120:cca96a509cfe
186 (insert string) 186 (insert string)
187 ;; correct for VM's uses of this function--- 187 ;; correct for VM's uses of this function---
188 ;; writing out message separators 188 ;; writing out message separators
189 (setq buffer-file-type nil) 189 (setq buffer-file-type nil)
190 ;; Tell XEmacs/MULE to pick the correct newline conversion. 190 ;; Tell XEmacs/MULE to pick the correct newline conversion.
191 (and (vm-xemacs-mule-p) 191 (and vm-xemacs-mule-p
192 (set-file-coding-system 'no-conversion nil)) 192 (set-file-coding-system 'no-conversion nil))
193 (write-region (point-min) (point-max) where t 'quiet)) 193 (write-region (point-min) (point-max) where t 'quiet))
194 (and temp-buffer (kill-buffer temp-buffer)))))) 194 (and temp-buffer (kill-buffer temp-buffer))))))
195 195
196 (defmacro vm-marker (pos &optional buffer) 196 (defmacro vm-marker (pos &optional buffer)
421 ((vectorp object) (apply 'vector (mapcar 'vm-copy object))) 421 ((vectorp object) (apply 'vector (mapcar 'vm-copy object)))
422 ((stringp object) (copy-sequence object)) 422 ((stringp object) (copy-sequence object))
423 ((markerp object) (copy-marker object)) 423 ((markerp object) (copy-marker object))
424 (t object))) 424 (t object)))
425 425
426 (defun vm-xemacs-p ()
427 (let ((case-fold-search nil))
428 (string-match "XEmacs" emacs-version)))
429
430 (defun vm-xemacs-mule-p ()
431 (and (vm-xemacs-p)
432 (featurep 'mule)
433 (fboundp 'set-file-coding-system)
434 (fboundp 'get-coding-system)))
435
436 (defun vm-fsfemacs-19-p ()
437 (and (string-match "^19" emacs-version)
438 (not (string-match "XEmacs\\|Lucid" emacs-version))))
439
440 ;; make-frame might be defined and still not work. This would 426 ;; make-frame might be defined and still not work. This would
441 ;; be true since the user could be running on a tty and using 427 ;; be true since the user could be running on a tty and using
442 ;; XEmacs 19.12, or using FSF Emacs 19.28 (or prior FSF Emacs versions). 428 ;; XEmacs 19.12, or using FSF Emacs 19.28 (or prior FSF Emacs versions).
443 ;; 429 ;;
444 ;; make-frame works on ttys in FSF Emacs 19.29, but other than 430 ;; make-frame works on ttys in FSF Emacs 19.29, but other than
459 (eq window-system 'ns) ;; NextStep 445 (eq window-system 'ns) ;; NextStep
460 (eq window-system 'win32))) 446 (eq window-system 'win32)))
461 (and (fboundp 'device-type) (eq (device-type) 'x)))) 447 (and (fboundp 'device-type) (eq (device-type) 'x))))
462 448
463 (defun vm-toolbar-support-possible-p () 449 (defun vm-toolbar-support-possible-p ()
464 (and (vm-xemacs-p) 450 (and vm-xemacs-p
465 (vm-multiple-frames-possible-p) 451 (vm-multiple-frames-possible-p)
466 (featurep 'toolbar))) 452 (featurep 'toolbar)))
467 453
468 (defun vm-multiple-fonts-possible-p () 454 (defun vm-multiple-fonts-possible-p ()
469 (or (eq window-system 'x) 455 (or (eq window-system 'x)
577 (or (get-file-buffer file) 563 (or (get-file-buffer file)
578 (and (fboundp 'file-truename) 564 (and (fboundp 'file-truename)
579 (get-file-buffer (file-truename file))))) 565 (get-file-buffer (file-truename file)))))
580 566
581 (defun vm-set-region-face (start end face) 567 (defun vm-set-region-face (start end face)
582 (cond ((fboundp 'make-overlay) 568 (let ((e (vm-make-extent start end)))
583 (let ((o (make-overlay start end))) 569 (vm-set-extent-property e 'face face)))
584 (overlay-put o 'face face)))
585 ((fboundp 'make-extent)
586 (let ((o (make-extent start end)))
587 (set-extent-property o 'face face)))))
588 570
589 (defun vm-default-buffer-substring-no-properties (beg end &optional buffer) 571 (defun vm-default-buffer-substring-no-properties (beg end &optional buffer)
590 (let ((s (if buffer 572 (let ((s (if buffer
591 (save-excursion 573 (save-excursion
592 (set-buffer buffer) 574 (set-buffer buffer)
596 (copy-sequence s))) 578 (copy-sequence s)))
597 579
598 (fset 'vm-buffer-substring-no-properties 580 (fset 'vm-buffer-substring-no-properties
599 (cond ((fboundp 'buffer-substring-no-properties) 581 (cond ((fboundp 'buffer-substring-no-properties)
600 (function buffer-substring-no-properties)) 582 (function buffer-substring-no-properties))
601 ((vm-xemacs-p) 583 (vm-xemacs-p
602 (function buffer-substring)) 584 (function buffer-substring))
603 (t (function vm-default-buffer-substring-no-properties)))) 585 (t (function vm-default-buffer-substring-no-properties))))
604 586
605 (defun vm-buffer-string-no-properties () 587 (defun vm-buffer-string-no-properties ()
606 (vm-buffer-substring-no-properties (point-min) (point-max))) 588 (vm-buffer-substring-no-properties (point-min) (point-max)))
615 (set-buffer target-buffer) 597 (set-buffer target-buffer)
616 (insert-buffer-substring buffer start end) 598 (insert-buffer-substring buffer start end)
617 (set-buffer buffer)) 599 (set-buffer buffer))
618 (set-buffer target-buffer))) 600 (set-buffer target-buffer)))
619 601
620 (if (fboundp 'overlay-get) 602 (if (not (fboundp 'vm-extent-property))
621 (fset 'vm-extent-property 'overlay-get) 603 (if (fboundp 'overlay-get)
622 (fset 'vm-extent-property 'extent-property)) 604 (fset 'vm-extent-property 'overlay-get)
623 605 (fset 'vm-extent-property 'extent-property)))
624 (if (fboundp 'overlay-put) 606
625 (fset 'vm-set-extent-property 'overlay-put) 607 (if (not (fboundp 'vm-set-extent-property))
626 (fset 'vm-set-extent-property 'set-extent-property)) 608 (if (fboundp 'overlay-put)
627 609 (fset 'vm-set-extent-property 'overlay-put)
628 (if (fboundp 'move-overlay) 610 (fset 'vm-set-extent-property 'set-extent-property)))
629 (fset 'vm-set-extent-endpoints 'move-overlay) 611
630 (fset 'vm-set-extent-endpoints 'set-extent-endpoints)) 612 (if (not (fboundp 'vm-set-extent-endpoints))
631 613 (if (fboundp 'move-overlay)
632 (if (fboundp 'make-overlay) 614 (fset 'vm-set-extent-endpoints 'move-overlay)
633 (fset 'vm-make-extent 'make-overlay) 615 (fset 'vm-set-extent-endpoints 'set-extent-endpoints)))
634 (fset 'vm-make-extent 'make-extent)) 616
635 617 (if (not (fboundp 'vm-make-extent))
636 (if (fboundp 'overlay-end) 618 (if (fboundp 'make-overlay)
637 (fset 'vm-extent-end-position 'overlay-end) 619 (fset 'vm-make-extent 'make-overlay)
638 (fset 'vm-extent-end-position 'extent-end-position)) 620 (fset 'vm-make-extent 'make-extent)))
639 621
640 (if (fboundp 'overlay-start) 622 (if (not (fboundp 'vm-extent-end-position))
641 (fset 'vm-extent-start-position 'overlay-start) 623 (if (fboundp 'overlay-end)
642 (fset 'vm-extent-start-position 'extent-start-position)) 624 (fset 'vm-extent-end-position 'overlay-end)
643 625 (fset 'vm-extent-end-position 'extent-end-position)))
644 (if (fboundp 'delete-overlay) 626
645 (fset 'vm-detach-extent 'delete-overlay) 627 (if (not (fboundp 'vm-extent-start-position))
646 (fset 'vm-detach-extent 'detach-extent)) 628 (if (fboundp 'overlay-start)
647 629 (fset 'vm-extent-start-position 'overlay-start)
648 (if (fboundp 'overlay-properties) 630 (fset 'vm-extent-start-position 'extent-start-position)))
649 (fset 'vm-extent-properties 'overlay-properties) 631
650 (fset 'vm-extent-properties 'extent-properties)) 632 (if (not (fboundp 'vm-detach-extent))
633 (if (fboundp 'delete-overlay)
634 (fset 'vm-detach-extent 'delete-overlay)
635 (fset 'vm-detach-extent 'detach-extent)))
636
637 (if (not (fboundp 'vm-extent-properties))
638 (if (fboundp 'overlay-properties)
639 (fset 'vm-extent-properties 'overlay-properties)
640 (fset 'vm-extent-properties 'extent-properties)))
651 641
652 (defun vm-copy-extent (e) 642 (defun vm-copy-extent (e)
653 (let ((props (vm-extent-properties e)) 643 (let ((props (vm-extent-properties e))
654 (ee (vm-make-extent (vm-extent-start-position e) 644 (ee (vm-make-extent (vm-extent-start-position e)
655 (vm-extent-end-position e)))) 645 (vm-extent-end-position e))))