|
0
|
1 ;;; nnheaderxm.el --- making Gnus backends work under XEmacs
|
|
|
2 ;; Copyright (C) 1996 Free Software Foundation, Inc.
|
|
|
3
|
|
|
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
|
|
|
5 ;; Keywords: news
|
|
|
6
|
|
|
7 ;; This file is part of GNU Emacs.
|
|
|
8
|
|
|
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
10 ;; it under the terms of the GNU General Public License as published by
|
|
|
11 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
12 ;; any later version.
|
|
|
13
|
|
|
14 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
17 ;; GNU General Public License for more details.
|
|
|
18
|
|
|
19 ;; You should have received a copy of the GNU General Public License
|
|
|
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
22 ;; Boston, MA 02111-1307, USA.
|
|
|
23
|
|
|
24 ;;; Commentary:
|
|
|
25
|
|
|
26 ;;; Code:
|
|
|
27
|
|
|
28 (defun nnheader-xmas-run-at-time (time repeat function &rest args)
|
|
|
29 (start-itimer
|
|
|
30 "nnheader-run-at-time"
|
|
|
31 `(lambda ()
|
|
|
32 (,function ,@args))
|
|
|
33 time repeat))
|
|
|
34
|
|
|
35 (defun nnheader-xmas-cancel-timer (timer)
|
|
|
36 (delete-itimer timer))
|
|
|
37
|
|
|
38 ;; Written by Erik Naggum <erik@naggum.no>.
|
|
|
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)))))
|
|
|
60
|
|
|
61 (defun nnheader-xmas-find-file-noselect (filename &optional nowarn rawfile)
|
|
|
62 "Read file FILENAME into a buffer and return the buffer.
|
|
|
63 If a buffer exists visiting FILENAME, return that one, but
|
|
|
64 verify that the file has not changed since visited or saved.
|
|
|
65 The buffer is not selected, just returned to the caller."
|
|
|
66 (setq filename
|
|
|
67 (abbreviate-file-name
|
|
|
68 (expand-file-name filename)))
|
|
|
69 (if (file-directory-p filename)
|
|
|
70 (if find-file-run-dired
|
|
|
71 (dired-noselect filename)
|
|
|
72 (error "%s is a directory." filename))
|
|
|
73 (let* ((buf (get-file-buffer filename))
|
|
|
74 (truename (abbreviate-file-name (file-truename filename)))
|
|
|
75 (number (nthcdr 10 (file-attributes truename)))
|
|
|
76 ;; Find any buffer for a file which has same truename.
|
|
|
77 (other (and (not buf)
|
|
|
78 (get-file-buffer filename)))
|
|
|
79 error)
|
|
|
80 ;; Let user know if there is a buffer with the same truename.
|
|
|
81 (if other
|
|
|
82 (progn
|
|
|
83 (or nowarn
|
|
|
84 (string-equal filename (buffer-file-name other))
|
|
|
85 (message "%s and %s are the same file"
|
|
|
86 filename (buffer-file-name other)))
|
|
|
87 ;; Optionally also find that buffer.
|
|
|
88 (if (or (and (boundp 'find-file-existing-other-name)
|
|
|
89 find-file-existing-other-name)
|
|
|
90 find-file-visit-truename)
|
|
|
91 (setq buf other))))
|
|
|
92 (if buf
|
|
|
93 (or nowarn
|
|
|
94 (verify-visited-file-modtime buf)
|
|
|
95 (cond ((not (file-exists-p filename))
|
|
|
96 (error "File %s no longer exists!" filename))
|
|
|
97 ((yes-or-no-p
|
|
|
98 (if (string= (file-name-nondirectory filename)
|
|
|
99 (buffer-name buf))
|
|
|
100 (format
|
|
|
101 (if (buffer-modified-p buf)
|
|
|
102 "File %s changed on disk. Discard your edits? "
|
|
|
103 "File %s changed on disk. Reread from disk? ")
|
|
|
104 (file-name-nondirectory filename))
|
|
|
105 (format
|
|
|
106 (if (buffer-modified-p buf)
|
|
|
107 "File %s changed on disk. Discard your edits in %s? "
|
|
|
108 "File %s changed on disk. Reread from disk into %s? ")
|
|
|
109 (file-name-nondirectory filename)
|
|
|
110 (buffer-name buf))))
|
|
|
111 (save-excursion
|
|
|
112 (set-buffer buf)
|
|
|
113 (revert-buffer t t)))))
|
|
|
114 (save-excursion
|
|
|
115 ;;; The truename stuff makes this obsolete.
|
|
|
116 ;;; (let* ((link-name (car (file-attributes filename)))
|
|
|
117 ;;; (linked-buf (and (stringp link-name)
|
|
|
118 ;;; (get-file-buffer link-name))))
|
|
|
119 ;;; (if (bufferp linked-buf)
|
|
|
120 ;;; (message "Symbolic link to file in buffer %s"
|
|
|
121 ;;; (buffer-name linked-buf))))
|
|
|
122 (setq buf (create-file-buffer filename))
|
|
|
123 ;; (set-buffer-major-mode buf)
|
|
|
124 (set-buffer buf)
|
|
|
125 (erase-buffer)
|
|
|
126 (if rawfile
|
|
|
127 (condition-case ()
|
|
|
128 (nnheader-insert-file-contents-literally filename t)
|
|
|
129 (file-error
|
|
|
130 ;; Unconditionally set error
|
|
|
131 (setq error t)))
|
|
|
132 (condition-case ()
|
|
|
133 (insert-file-contents filename t)
|
|
|
134 (file-error
|
|
|
135 ;; Run find-file-not-found-hooks until one returns non-nil.
|
|
|
136 (or t ; (run-hook-with-args-until-success 'find-file-not-found-hooks)
|
|
|
137 ;; If they fail too, set error.
|
|
|
138 (setq error t)))))
|
|
|
139 ;; Find the file's truename, and maybe use that as visited name.
|
|
|
140 (setq buffer-file-truename truename)
|
|
|
141 (setq buffer-file-number number)
|
|
|
142 ;; On VMS, we may want to remember which directory in a search list
|
|
|
143 ;; the file was found in.
|
|
|
144 (and (eq system-type 'vax-vms)
|
|
|
145 (let (logical)
|
|
|
146 (if (string-match ":" (file-name-directory filename))
|
|
|
147 (setq logical (substring (file-name-directory filename)
|
|
|
148 0 (match-beginning 0))))
|
|
|
149 (not (member logical find-file-not-true-dirname-list)))
|
|
|
150 (setq buffer-file-name buffer-file-truename))
|
|
|
151 (if find-file-visit-truename
|
|
|
152 (setq buffer-file-name
|
|
|
153 (setq filename
|
|
|
154 (expand-file-name buffer-file-truename))))
|
|
|
155 ;; Set buffer's default directory to that of the file.
|
|
|
156 (setq default-directory (file-name-directory filename))
|
|
|
157 ;; Turn off backup files for certain file names. Since
|
|
|
158 ;; this is a permanent local, the major mode won't eliminate it.
|
|
|
159 (and (not (funcall backup-enable-predicate buffer-file-name))
|
|
|
160 (progn
|
|
|
161 (make-local-variable 'backup-inhibited)
|
|
|
162 (setq backup-inhibited t)))
|
|
|
163 (if rawfile
|
|
|
164 nil
|
|
|
165 (after-find-file error (not nowarn)))))
|
|
|
166 buf)))
|
|
|
167
|
|
|
168 (fset 'nnheader-run-at-time 'nnheader-xmas-run-at-time)
|
|
|
169 (fset 'nnheader-cancel-timer 'nnheader-xmas-cancel-timer)
|
|
|
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))
|
|
|
175
|
|
|
176 (provide 'nnheaderxm)
|
|
|
177
|
|
|
178 ;;; nnheaderxm.el ends here.
|
