Mercurial > hg > xemacs-beta

comparison lisp/gnus/nnheaderxm.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents ec9a17fef872
children 0d2f883870bc
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; nnheaderxm.el --- making Gnus backends work under XEmacs 1 ;;; nnheaderxm.el --- making Gnus backends work under XEmacs
2 ;; Copyright (C) 1996,97 Free Software Foundation, Inc. 2 ;; Copyright (C) 1996 Free Software Foundation, Inc.
3 3
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no> 4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
5 ;; Keywords: news 5 ;; Keywords: news
6 6
7 ;; This file is part of GNU Emacs. 7 ;; This file is part of GNU Emacs.
23 23
24 ;;; Commentary: 24 ;;; Commentary:
25 25
26 ;;; Code: 26 ;;; Code:
27 27
28 (eval-and-compile
29 (autoload 'nnheader-insert-file-contents "nnheader"))
30
31 (defun nnheader-xmas-run-at-time (time repeat function &rest args) 28 (defun nnheader-xmas-run-at-time (time repeat function &rest args)
32 (start-itimer 29 (start-itimer
33 "nnheader-run-at-time" 30 "nnheader-run-at-time"
34 `(lambda () 31 `(lambda ()
35 (,function ,@args)) 32 (,function ,@args))
36 time repeat)) 33 time repeat))
37 34
38 (defun nnheader-xmas-cancel-timer (timer) 35 (defun nnheader-xmas-cancel-timer (timer)
39 (delete-itimer timer)) 36 (delete-itimer timer))
40 37
41 (defun nnheader-xmas-cancel-function-timers (function) 38 ;; Written by Erik Naggum <erik@naggum.no>.
42 ) 39 ;; Saved by Steve Baur <steve@miranova.com>.
40 (defun nnheader-xmas-insert-file-contents-literally (filename &optional visit beg end replace)
41 "Like `insert-file-contents', q.v., but only reads in the file.
42 A buffer may be modified in several ways after reading into the buffer due
43 to advanced Emacs features, such as file-name-handlers, format decoding,
44 find-file-hooks, etc.
45 This function ensures that none of these modifications will take place."
46 (let ( ; (file-name-handler-alist nil)
47 (format-alist nil)
48 (after-insert-file-functions nil)
49 (find-buffer-file-type-function
50 (if (fboundp 'find-buffer-file-type)
51 (symbol-function 'find-buffer-file-type)
52 nil)))
53 (unwind-protect
54 (progn
55 (fset 'find-buffer-file-type (lambda (filename) t))
56 (insert-file-contents filename visit beg end replace))
57 (if find-buffer-file-type-function
58 (fset 'find-buffer-file-type find-buffer-file-type-function)
59 (fmakunbound 'find-buffer-file-type)))))
43 60
44 (defun nnheader-xmas-find-file-noselect (filename &optional nowarn rawfile) 61 (defun nnheader-xmas-find-file-noselect (filename &optional nowarn rawfile)
45 "Read file FILENAME into a buffer and return the buffer. 62 "Read file FILENAME into a buffer and return the buffer.
46 If a buffer exists visiting FILENAME, return that one, but 63 If a buffer exists visiting FILENAME, return that one, but
47 verify that the file has not changed since visited or saved. 64 verify that the file has not changed since visited or saved.
55 (error "%s is a directory." filename)) 72 (error "%s is a directory." filename))
56 (let* ((buf (get-file-buffer filename)) 73 (let* ((buf (get-file-buffer filename))
57 (truename (abbreviate-file-name (file-truename filename))) 74 (truename (abbreviate-file-name (file-truename filename)))
58 (number (nthcdr 10 (file-attributes truename))) 75 (number (nthcdr 10 (file-attributes truename)))
59 ;; Find any buffer for a file which has same truename. 76 ;; Find any buffer for a file which has same truename.
60 (other (and (not buf) 77 (other (and (not buf)
61 (get-file-buffer filename))) 78 (get-file-buffer filename)))
62 error) 79 error)
63 ;; Let user know if there is a buffer with the same truename. 80 ;; Let user know if there is a buffer with the same truename.
64 (when other 81 (if other
65 (or nowarn 82 (progn
66 (string-equal filename (buffer-file-name other)) 83 (or nowarn
67 (message "%s and %s are the same file" 84 (string-equal filename (buffer-file-name other))
68 filename (buffer-file-name other))) 85 (message "%s and %s are the same file"
69 ;; Optionally also find that buffer. 86 filename (buffer-file-name other)))
70 (when (or (and (boundp 'find-file-existing-other-name) 87 ;; Optionally also find that buffer.
71 find-file-existing-other-name) 88 (if (or (and (boundp 'find-file-existing-other-name)
72 find-file-visit-truename) 89 find-file-existing-other-name)
73 (setq buf other))) 90 find-file-visit-truename)
91 (setq buf other))))
74 (if buf 92 (if buf
75 (or nowarn 93 (or nowarn
76 (verify-visited-file-modtime buf) 94 (verify-visited-file-modtime buf)
77 (cond ((not (file-exists-p filename)) 95 (cond ((not (file-exists-p filename))
78 (error "File %s no longer exists!" filename)) 96 (error "File %s no longer exists!" filename))
105 ;; (set-buffer-major-mode buf) 123 ;; (set-buffer-major-mode buf)
106 (set-buffer buf) 124 (set-buffer buf)
107 (erase-buffer) 125 (erase-buffer)
108 (if rawfile 126 (if rawfile
109 (condition-case () 127 (condition-case ()
110 (nnheader-insert-file-contents filename t) 128 (nnheader-insert-file-contents-literally filename t)
111 (file-error 129 (file-error
112 ;; Unconditionally set error 130 ;; Unconditionally set error
113 (setq error t))) 131 (setq error t)))
114 (condition-case () 132 (condition-case ()
115 (insert-file-contents filename t) 133 (insert-file-contents filename t)
123 (setq buffer-file-number number) 141 (setq buffer-file-number number)
124 ;; On VMS, we may want to remember which directory in a search list 142 ;; On VMS, we may want to remember which directory in a search list
125 ;; the file was found in. 143 ;; the file was found in.
126 (and (eq system-type 'vax-vms) 144 (and (eq system-type 'vax-vms)
127 (let (logical) 145 (let (logical)
128 (when (string-match ":" (file-name-directory filename)) 146 (if (string-match ":" (file-name-directory filename))
129 (setq logical (substring (file-name-directory filename) 147 (setq logical (substring (file-name-directory filename)
130 0 (match-beginning 0)))) 148 0 (match-beginning 0))))
131 (not (member logical find-file-not-true-dirname-list))) 149 (not (member logical find-file-not-true-dirname-list)))
132 (setq buffer-file-name buffer-file-truename)) 150 (setq buffer-file-name buffer-file-truename))
133 (when find-file-visit-truename 151 (if find-file-visit-truename
134 (setq buffer-file-name 152 (setq buffer-file-name
135 (setq filename 153 (setq filename
136 (expand-file-name buffer-file-truename)))) 154 (expand-file-name buffer-file-truename))))
137 ;; Set buffer's default directory to that of the file. 155 ;; Set buffer's default directory to that of the file.
138 (setq default-directory (file-name-directory filename)) 156 (setq default-directory (file-name-directory filename))
139 ;; Turn off backup files for certain file names. Since 157 ;; Turn off backup files for certain file names. Since
140 ;; this is a permanent local, the major mode won't eliminate it. 158 ;; this is a permanent local, the major mode won't eliminate it.
141 (when (not (funcall backup-enable-predicate buffer-file-name)) 159 (and (not (funcall backup-enable-predicate buffer-file-name))
142 (make-local-variable 'backup-inhibited) 160 (progn
143 (setq backup-inhibited t)) 161 (make-local-variable 'backup-inhibited)
162 (setq backup-inhibited t)))
144 (if rawfile 163 (if rawfile
145 nil 164 nil
146 (after-find-file error (not nowarn))))) 165 (after-find-file error (not nowarn)))))
147 buf))) 166 buf)))
148 167
149 (fset 'nnheader-run-at-time 'nnheader-xmas-run-at-time) 168 (fset 'nnheader-run-at-time 'nnheader-xmas-run-at-time)
150 (fset 'nnheader-cancel-timer 'nnheader-xmas-cancel-timer) 169 (fset 'nnheader-cancel-timer 'nnheader-xmas-cancel-timer)
151 (fset 'nnheader-cancel-function-timers 'nnheader-xmas-cancel-function-timers)
152 (fset 'nnheader-find-file-noselect 'nnheader-xmas-find-file-noselect) 170 (fset 'nnheader-find-file-noselect 'nnheader-xmas-find-file-noselect)
171 (fset 'nnheader-insert-file-contents-literally
172 (if (fboundp 'insert-file-contents-literally)
173 'insert-file-contents-literally
174 'nnheader-xmas-insert-file-contents-literally))
153 175
154 (provide 'nnheaderxm) 176 (provide 'nnheaderxm)
155 177
156 ;;; nnheaderxm.el ends here. 178 ;;; nnheaderxm.el ends here.