Mercurial > hg > xemacs-beta

comparison lisp/gnus/nnheaderxm.el @ 98:0d2f883870bc r20-1b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b1
author cvs
date Mon, 13 Aug 2007 09:13:56 +0200
parents 131b0175ea99
children 360340f9fd5f
comparison
equal deleted inserted replaced
97:498bf5da1c90 98:0d2f883870bc
1 ;;; nnheaderxm.el --- making Gnus backends work under XEmacs 1 ;;; nnheaderxm.el --- making Gnus backends work under XEmacs
2 ;; Copyright (C) 1996 Free Software Foundation, Inc. 2 ;; Copyright (C) 1996,97 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.
33 time repeat)) 33 time repeat))
34 34
35 (defun nnheader-xmas-cancel-timer (timer) 35 (defun nnheader-xmas-cancel-timer (timer)
36 (delete-itimer timer)) 36 (delete-itimer timer))
37 37
38 ;; Written by Erik Naggum <erik@naggum.no>. 38 (defun nnheader-xmas-cancel-function-timers (function)
39 ;; Saved by Steve Baur <steve@miranova.com>. 39 )
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)))))
60 40
61 (defun nnheader-xmas-find-file-noselect (filename &optional nowarn rawfile) 41 (defun nnheader-xmas-find-file-noselect (filename &optional nowarn rawfile)
62 "Read file FILENAME into a buffer and return the buffer. 42 "Read file FILENAME into a buffer and return the buffer.
63 If a buffer exists visiting FILENAME, return that one, but 43 If a buffer exists visiting FILENAME, return that one, but
64 verify that the file has not changed since visited or saved. 44 verify that the file has not changed since visited or saved.
72 (error "%s is a directory." filename)) 52 (error "%s is a directory." filename))
73 (let* ((buf (get-file-buffer filename)) 53 (let* ((buf (get-file-buffer filename))
74 (truename (abbreviate-file-name (file-truename filename))) 54 (truename (abbreviate-file-name (file-truename filename)))
75 (number (nthcdr 10 (file-attributes truename))) 55 (number (nthcdr 10 (file-attributes truename)))
76 ;; Find any buffer for a file which has same truename. 56 ;; Find any buffer for a file which has same truename.
77 (other (and (not buf) 57 (other (and (not buf)
78 (get-file-buffer filename))) 58 (get-file-buffer filename)))
79 error) 59 error)
80 ;; Let user know if there is a buffer with the same truename. 60 ;; Let user know if there is a buffer with the same truename.
81 (if other 61 (when other
82 (progn 62 (or nowarn
83 (or nowarn 63 (string-equal filename (buffer-file-name other))
84 (string-equal filename (buffer-file-name other)) 64 (message "%s and %s are the same file"
85 (message "%s and %s are the same file" 65 filename (buffer-file-name other)))
86 filename (buffer-file-name other))) 66 ;; Optionally also find that buffer.
87 ;; Optionally also find that buffer. 67 (when (or (and (boundp 'find-file-existing-other-name)
88 (if (or (and (boundp 'find-file-existing-other-name) 68 find-file-existing-other-name)
89 find-file-existing-other-name) 69 find-file-visit-truename)
90 find-file-visit-truename) 70 (setq buf other)))
91 (setq buf other))))
92 (if buf 71 (if buf
93 (or nowarn 72 (or nowarn
94 (verify-visited-file-modtime buf) 73 (verify-visited-file-modtime buf)
95 (cond ((not (file-exists-p filename)) 74 (cond ((not (file-exists-p filename))
96 (error "File %s no longer exists!" filename)) 75 (error "File %s no longer exists!" filename))
123 ;; (set-buffer-major-mode buf) 102 ;; (set-buffer-major-mode buf)
124 (set-buffer buf) 103 (set-buffer buf)
125 (erase-buffer) 104 (erase-buffer)
126 (if rawfile 105 (if rawfile
127 (condition-case () 106 (condition-case ()
128 (nnheader-insert-file-contents-literally filename t) 107 (nnheader-insert-file-contents filename t)
129 (file-error 108 (file-error
130 ;; Unconditionally set error 109 ;; Unconditionally set error
131 (setq error t))) 110 (setq error t)))
132 (condition-case () 111 (condition-case ()
133 (insert-file-contents filename t) 112 (insert-file-contents filename t)
141 (setq buffer-file-number number) 120 (setq buffer-file-number number)
142 ;; On VMS, we may want to remember which directory in a search list 121 ;; On VMS, we may want to remember which directory in a search list
143 ;; the file was found in. 122 ;; the file was found in.
144 (and (eq system-type 'vax-vms) 123 (and (eq system-type 'vax-vms)
145 (let (logical) 124 (let (logical)
146 (if (string-match ":" (file-name-directory filename)) 125 (when (string-match ":" (file-name-directory filename))
147 (setq logical (substring (file-name-directory filename) 126 (setq logical (substring (file-name-directory filename)
148 0 (match-beginning 0)))) 127 0 (match-beginning 0))))
149 (not (member logical find-file-not-true-dirname-list))) 128 (not (member logical find-file-not-true-dirname-list)))
150 (setq buffer-file-name buffer-file-truename)) 129 (setq buffer-file-name buffer-file-truename))
151 (if find-file-visit-truename 130 (when find-file-visit-truename
152 (setq buffer-file-name 131 (setq buffer-file-name
153 (setq filename 132 (setq filename
154 (expand-file-name buffer-file-truename)))) 133 (expand-file-name buffer-file-truename))))
155 ;; Set buffer's default directory to that of the file. 134 ;; Set buffer's default directory to that of the file.
156 (setq default-directory (file-name-directory filename)) 135 (setq default-directory (file-name-directory filename))
157 ;; Turn off backup files for certain file names. Since 136 ;; Turn off backup files for certain file names. Since
158 ;; this is a permanent local, the major mode won't eliminate it. 137 ;; this is a permanent local, the major mode won't eliminate it.
159 (and (not (funcall backup-enable-predicate buffer-file-name)) 138 (when (not (funcall backup-enable-predicate buffer-file-name))
160 (progn 139 (make-local-variable 'backup-inhibited)
161 (make-local-variable 'backup-inhibited) 140 (setq backup-inhibited t))
162 (setq backup-inhibited t)))
163 (if rawfile 141 (if rawfile
164 nil 142 nil
165 (after-find-file error (not nowarn))))) 143 (after-find-file error (not nowarn)))))
166 buf))) 144 buf)))
167 145
168 (fset 'nnheader-run-at-time 'nnheader-xmas-run-at-time) 146 (fset 'nnheader-run-at-time 'nnheader-xmas-run-at-time)
169 (fset 'nnheader-cancel-timer 'nnheader-xmas-cancel-timer) 147 (fset 'nnheader-cancel-timer 'nnheader-xmas-cancel-timer)
148 (fset 'nnheader-cancel-function-timers 'nnheader-xmas-cancel-function-timers)
170 (fset 'nnheader-find-file-noselect 'nnheader-xmas-find-file-noselect) 149 (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))
175 150
176 (provide 'nnheaderxm) 151 (provide 'nnheaderxm)
177 152
178 ;;; nnheaderxm.el ends here. 153 ;;; nnheaderxm.el ends here.