Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-misc.el @ 24:4103f0995bd7 r19-15b95

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b95
author cvs
date Mon, 13 Aug 2007 08:51:03 +0200
parents 859a2309aef8
children 441bb1e64a06
comparison
equal deleted inserted replaced
23:0edd3412f124 24:4103f0995bd7
102 (unwind-protect 102 (unwind-protect
103 (save-excursion 103 (save-excursion
104 (setq temp-buffer (generate-new-buffer "*vm-work*")) 104 (setq temp-buffer (generate-new-buffer "*vm-work*"))
105 (set-buffer temp-buffer) 105 (set-buffer temp-buffer)
106 (insert string) 106 (insert string)
107 ;; correct for VM's uses of this function---
108 ;; writing out message separators
109 (setq buffer-file-type nil)
110 ;; Tell XEmacs/MULE to pick the correct newline conversion.
111 (and (fboundp 'set-file-coding-system)
112 (set-file-coding-system 'no-conversion nil))
107 (write-region (point-min) (point-max) where t 'quiet)) 113 (write-region (point-min) (point-max) where t 'quiet))
108 (and temp-buffer (kill-buffer temp-buffer)))))) 114 (and temp-buffer (kill-buffer temp-buffer))))))
109 115
110 (defmacro vm-marker (pos &optional buffer) 116 (defmacro vm-marker (pos &optional buffer)
111 (list 'set-marker '(make-marker) pos buffer)) 117 (list 'set-marker '(make-marker) pos buffer))
267 (while list 273 (while list
268 (setq sym-string 274 (setq sym-string
269 (if hack-addresses 275 (if hack-addresses
270 (nth 1 (funcall vm-chop-full-name-function (car list))) 276 (nth 1 (funcall vm-chop-full-name-function (car list)))
271 (car list)) 277 (car list))
278 sym-string (or sym-string "-unparseable-garbage-")
272 sym (intern sym-string hashtable)) 279 sym (intern sym-string hashtable))
273 (if (boundp sym) 280 (if (boundp sym)
274 (and all (setcar (symbol-value sym) nil)) 281 (and all (setcar (symbol-value sym) nil))
275 (setq new-list (cons (car list) new-list)) 282 (setq new-list (cons (car list) new-list))
276 (set sym new-list)) 283 (set sym new-list))
373 380
374 (defun vm-toolbar-support-possible-p () 381 (defun vm-toolbar-support-possible-p ()
375 (and (vm-xemacs-p) 382 (and (vm-xemacs-p)
376 (vm-multiple-frames-possible-p) 383 (vm-multiple-frames-possible-p)
377 (featurep 'toolbar))) 384 (featurep 'toolbar)))
385
386 (defun vm-multiple-fonts-possible-p ()
387 (or (eq window-system 'x)
388 (and (fboundp 'device-type)
389 (eq (device-type) 'x))))
378 390
379 (defun vm-run-message-hook (message &optional hook-variable) 391 (defun vm-run-message-hook (message &optional hook-variable)
380 (save-excursion 392 (save-excursion
381 (set-buffer (vm-buffer-of message)) 393 (set-buffer (vm-buffer-of message))
382 (vm-save-restriction 394 (vm-save-restriction
557 (let ((props (vm-extent-properties e)) 569 (let ((props (vm-extent-properties e))
558 (ee (vm-make-extent (vm-extent-start-position e) 570 (ee (vm-make-extent (vm-extent-start-position e)
559 (vm-extent-end-position e)))) 571 (vm-extent-end-position e))))
560 (while props 572 (while props
561 (vm-set-extent-property ee (car props) (car (cdr props))) 573 (vm-set-extent-property ee (car props) (car (cdr props)))
562 (setq props (cdr props))))) 574 (setq props (cdr (cdr props))))))
563 575
564 (defun vm-make-tempfile-name () 576 (defun vm-make-tempfile-name ()
565 (let ((done nil) (pid (emacs-pid)) filename) 577 (let ((done nil) (pid (emacs-pid)) filename)
566 (while (not done) 578 (while (not done)
567 (setq filename (format "%s/vm%d.%d" vm-temp-file-directory pid 579 (setq filename (format "%s/vm%d.%d" vm-temp-file-directory pid
596 608
597 (defun vm-set-buffer-variable (buffer var value) 609 (defun vm-set-buffer-variable (buffer var value)
598 (save-excursion 610 (save-excursion
599 (set-buffer buffer) 611 (set-buffer buffer)
600 (set var value))) 612 (set var value)))
613
614 (defun vm-buffer-variable-value (buffer var)
615 (save-excursion
616 (set-buffer buffer)
617 (symbol-value var)))
601 618
602 (defsubst vm-with-string-as-temp-buffer (string function) 619 (defsubst vm-with-string-as-temp-buffer (string function)
603 (let ((work-buffer nil)) 620 (let ((work-buffer nil))
604 (unwind-protect 621 (unwind-protect
605 (save-excursion 622 (save-excursion
607 (set-buffer work-buffer) 624 (set-buffer work-buffer)
608 (insert string) 625 (insert string)
609 (funcall function) 626 (funcall function)
610 (buffer-string)) 627 (buffer-string))
611 (and work-buffer (kill-buffer work-buffer))))) 628 (and work-buffer (kill-buffer work-buffer)))))
629
630 (defmacro vm-with-virtual-selector-variables (&rest forms)
631 (append '(let ((any 'vm-vs-any)
632 (and 'vm-vs-and)
633 (or 'vm-vs-or)
634 (not 'vm-vs-not)
635 (header 'vm-vs-header)
636 (label 'vm-vs-label)
637 (text 'vm-vs-text)
638 (recipient 'vm-vs-recipient)
639 (author 'vm-vs-author)
640 (subject 'vm-vs-subject)
641 (sent-before 'vm-vs-sent-before)
642 (sent-after 'vm-vs-sent-after)
643 (more-chars-than 'vm-vs-more-chars-than)
644 (less-chars-than 'vm-vs-less-chars-than)
645 (more-lines-than 'vm-vs-more-lines-than)
646 (less-lines-than 'vm-vs-less-lines-than)
647 (new 'vm-vs-new)
648 (unread 'vm-vs-unread)
649 (read 'vm-vs-read)
650 (deleted 'vm-vs-deleted)
651 (replied 'vm-vs-replied)
652 (forwarded 'vm-vs-forwarded)
653 (filed 'vm-vs-filed)
654 (written 'vm-vs-written)
655 (edited 'vm-vs-edited)
656 (marked 'vm-vs-marked)))
657 forms))
658
659 (defun vm-string-assoc (elt list)
660 (let ((case-fold-search t)
661 (found nil)
662 (elt (regexp-quote elt)))
663 (while (and list (not found))
664 (if (and (equal 0 (string-match elt (car (car list))))
665 (= (match-end 0) (length (car (car list)))))
666 (setq found t)
667 (setq list (cdr list))))
668 (car list)))
669
670 (defun vm-string-member (elt list)
671 (let ((case-fold-search t)
672 (found nil)
673 (elt (regexp-quote elt)))
674 (while (and list (not found))
675 (if (and (equal 0 (string-match elt (car list)))
676 (= (match-end 0) (length (car list))))
677 (setq found t)
678 (setq list (cdr list))))
679 list))