← Back to branch summary

~ubuntu-branches/ubuntu/hardy/vm/hardy

« back to all changes in this revision

Viewing changes to vm-misc.el

  • Committer: Bazaar Package Importer
  • Author(s): Manoj Srivastava
  • Date: 2005-05-02 23:57:59 UTC
  • mfrom: (2.1.2 hoary)
  • Revision ID: james.westby@ubuntu.com-20050502235759-lsq60hinwkchrbxp
Tags: 7.19-4
http://bugs.debian.org/306876
http://bugs.debian.org/303519
* Bug fix: "vm: Please do not discriminate against XEmacs", thanks to
  Dirk Eddelbuettel. Well, back in the mists of time, VM was packaged to
  be byte-compiled for XEmacs, but the XEmacs maintainer at that time
  asked me to cease and desist. Times change, so that is reverted. 
                                                        (Closes: #306876).
* Bug fix: "vm: purge doesn't", thanks to Ian Zimmerman. This should be
  better.                                               (Closes: #303519).

Show diffs side-by-side

added added

removed removed

Lines of Context:
vm-misc.el
15
15
;;; along with this program; if not, write to the Free Software
16
16
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
17
17
 
18
 
(provide 'vm-misc)
 
18
;;(provide 'vm-misc)
19
19
 
20
20
(defun vm-delete-non-matching-strings (regexp list &optional destructively)
21
21
  "Delete strings matching REGEXP from LIST.
36
36
          (setq curr (cdr curr)))))
37
37
    list ))
38
38
 
39
 
(defun vm-parse (string regexp &optional matchn)
 
39
(defun vm-parse (string regexp &optional matchn matches)
40
40
  (or matchn (setq matchn 1))
41
41
  (let (list tem)
42
42
    (store-match-data nil)
43
 
    (while (string-match regexp string (match-end 0))
 
43
    (while (and (not (eq matches 0))
 
44
                (string-match regexp string (match-end 0)))
 
45
      (and (integerp matches) (setq matches (1- matches)))
44
46
      (if (not (consp matchn))
45
47
          (setq list (cons (substring string (match-beginning matchn)
46
48
                                      (match-end matchn)) list))
52
54
                                          (match-end (car tem))) list)
53
55
                    tem nil)
54
56
            (setq tem (cdr tem))))))
55
 
    (nreverse list)))
 
57
   (if (and (integerp matches) (match-end 0)
 
58
            (not (eq (match-end 0) (length string))))
 
59
       (setq list (cons (substring string (match-end 0) (length string))
 
60
                         list)))
 
61
   (nreverse list)))
56
62
 
57
63
(defun vm-parse-addresses (string)
58
64
  (if (null string)
190
196
        (goto-char (point-max))
191
197
        (let ((buffer-read-only nil))
192
198
          (insert string)))
193
 
    (let ((temp-buffer nil)
194
 
          (coding-system-for-write (vm-line-ending-coding-system)))
 
199
    (let ((temp-buffer nil))
195
200
      (unwind-protect
196
201
          (save-excursion
197
202
            (setq temp-buffer (generate-new-buffer "*vm-work*"))
201
206
            ;; correct for VM's uses of this function---
202
207
            ;; writing out message separators
203
208
            (setq buffer-file-type nil)
204
 
            ;; Tell MULE to pick the correct newline conversion.
205
 
            (if (fboundp 'set-buffer-file-coding-system)
206
 
                (set-buffer-file-coding-system 
207
 
                 (vm-line-ending-coding-system) nil))
208
209
            (write-region (point-min) (point-max) where t 'quiet))
209
210
        (and temp-buffer (kill-buffer temp-buffer))))))
210
211
 
605
606
      (vm-set-extent-property ee (car props) (car (cdr props)))
606
607
      (setq props (cdr (cdr props))))))
607
608
 
608
 
(defun vm-make-tempfile (&optional filename-suffix)
 
609
(defun vm-make-tempfile (&optional filename-suffix proposed-filename)
609
610
  (let ((modes (default-file-modes))
610
 
        (file (vm-make-tempfile-name filename-suffix)))
 
611
        (file (vm-make-tempfile-name filename-suffix proposed-filename)))
611
612
    (unwind-protect
612
613
        (progn
613
 
          ;; mode 600
614
 
          (set-default-file-modes (* 6 8 8))
 
614
          (set-default-file-modes (vm-octal 600))
615
615
          (vm-error-free-call 'delete-file file)
616
616
          (write-region (point) (point) file nil 0))
617
617
      (set-default-file-modes modes))
618
618
    file ))
619
619
 
620
 
(defun vm-make-tempfile-name (&optional filename-suffix)
621
 
  (let ((done nil) filename)
622
 
    (while (not done)
623
 
      (setq filename (convert-standard-filename
624
 
                      (expand-file-name (format "vm%d%d%s"
625
 
                                                vm-tempfile-counter
626
 
                                                (random 100000000)
627
 
                                                (or filename-suffix ""))
628
 
                                        vm-temp-file-directory))
629
 
            vm-tempfile-counter (1+ vm-tempfile-counter)
630
 
            done (not (file-exists-p filename))))
 
620
(defun vm-make-tempfile-name (&optional filename-suffix proposed-filename)
 
621
  (let (filename)
 
622
    (cond ((and (stringp proposed-filename)
 
623
                (not (file-exists-p
 
624
                      (setq filename (convert-standard-filename
 
625
                                      (expand-file-name
 
626
                                       proposed-filename
 
627
                                       vm-temp-file-directory))))))
 
628
           t )
 
629
          ((stringp proposed-filename)
 
630
           (let ((done nil))
 
631
             (while (not done)
 
632
               (setq filename (convert-standard-filename
 
633
                               (expand-file-name
 
634
                                (format "%d-%s"
 
635
                                        vm-tempfile-counter
 
636
                                        proposed-filename)
 
637
                                vm-temp-file-directory))
 
638
                     vm-tempfile-counter (1+ vm-tempfile-counter)
 
639
                     done (not (file-exists-p filename))))))
 
640
          (t
 
641
           (let ((done nil))
 
642
             (while (not done)
 
643
               (setq filename (convert-standard-filename
 
644
                               (expand-file-name
 
645
                                (format "vm%d%d%s"
 
646
                                        vm-tempfile-counter
 
647
                                        (random 100000000)
 
648
                                        (or filename-suffix ""))
 
649
                                vm-temp-file-directory))
 
650
                     vm-tempfile-counter (1+ vm-tempfile-counter)
 
651
                     done (not (file-exists-p filename)))))))
631
652
    filename ))
632
653
 
633
654
(defun vm-make-work-buffer (&optional name)
763
784
      (t
764
785
       (fset 'vm-coding-system-name 'symbol-name)))
765
786
 
 
787
(defun vm-get-file-line-ending-coding-system (file)
 
788
  (if (not (or vm-fsfemacs-mule-p vm-xemacs-mule-p vm-xemacs-file-coding-p))
 
789
      nil
 
790
    (let ((coding-system-for-read  (vm-binary-coding-system))
 
791
          (work-buffer nil))
 
792
      (unwind-protect
 
793
          (save-excursion
 
794
            (setq work-buffer (vm-make-work-buffer))
 
795
            (set-buffer work-buffer)
 
796
            (condition-case nil
 
797
                (insert-file-contents file nil 0 4096)
 
798
              (error nil))
 
799
            (goto-char (point-min))
 
800
            (cond ((re-search-forward "[^\r]\n" nil t)
 
801
                   (if vm-fsfemacs-mule-p 'raw-text-unix 'no-conversion-unix))
 
802
                  ((re-search-forward "\r[^\n]" nil t)
 
803
                   (if vm-fsfemacs-mule-p 'raw-text-mac 'no-conversion-mac))
 
804
                  ((search-forward "\r\n" nil t)
 
805
                   (if vm-fsfemacs-mule-p 'raw-text-dos 'no-conversion-dos))
 
806
                  (t (vm-line-ending-coding-system))))
 
807
        (and work-buffer (kill-buffer work-buffer))))))
 
808
 
 
809
(defun vm-new-folder-line-ending-coding-system ()
 
810
  (cond ((eq vm-default-new-folder-line-ending-type nil)
 
811
         (vm-line-ending-coding-system))
 
812
        ((eq vm-default-new-folder-line-ending-type 'lf)
 
813
         (if vm-fsfemacs-mule-p 'raw-text-unix 'no-conversion-unix))
 
814
        ((eq vm-default-new-folder-line-ending-type 'crlf)
 
815
         (if vm-fsfemacs-mule-p 'raw-text-dos 'no-conversion-dos))
 
816
        ((eq vm-default-new-folder-line-ending-type 'cr)
 
817
         (if vm-fsfemacs-mule-p 'raw-text-mac 'no-conversion-mac))
 
818
        (t
 
819
         (vm-line-ending-coding-system))))
 
820
 
766
821
(defun vm-collapse-whitespace ()
767
822
  (goto-char (point-min))
768
823
  (while (re-search-forward "[ \t\n]+" nil 0)
849
904
  (vm-with-string-as-temp-buffer string 'vm-url-decode-buffer))
850
905
 
851
906
(defun vm-url-decode-buffer ()
852
 
  (let ((case-fold-search nil)
 
907
  (let ((case-fold-search t)
853
908
        (hex-digit-alist '((?0 .  0)  (?1 .  1)  (?2 .  2)  (?3 .  3)
854
909
                           (?4 .  4)  (?5 .  5)  (?6 .  6)  (?7 .  7)
855
910
                           (?8 .  8)  (?9 .  9)  (?A . 10)  (?B . 11)
879
934
        (setq size (- size (frame-pixel-width)))
880
935
        (scroll-bar-mode nil)
881
936
        (setq vm-fsfemacs-cached-scroll-bar-width size))))
 
937
 
 
938
(provide 'vm-misc)