0
|
1 ;;; nnheaderxm.el --- making Gnus backends work under XEmacs
|
16
|
2 ;; Copyright (C) 1996,97 Free Software Foundation, Inc.
|
0
|
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
|
16
|
38 (defun nnheader-xmas-cancel-function-timers (function)
|
|
39 )
|
0
|
40
|
|
41 (defun nnheader-xmas-find-file-noselect (filename &optional nowarn rawfile)
|
|
42 "Read file FILENAME into a buffer and return the buffer.
|
|
43 If a buffer exists visiting FILENAME, return that one, but
|
|
44 verify that the file has not changed since visited or saved.
|
|
45 The buffer is not selected, just returned to the caller."
|
|
46 (setq filename
|
|
47 (abbreviate-file-name
|
|
48 (expand-file-name filename)))
|
|
49 (if (file-directory-p filename)
|
|
50 (if find-file-run-dired
|
|
51 (dired-noselect filename)
|
|
52 (error "%s is a directory." filename))
|
|
53 (let* ((buf (get-file-buffer filename))
|
|
54 (truename (abbreviate-file-name (file-truename filename)))
|
|
55 (number (nthcdr 10 (file-attributes truename)))
|
|
56 ;; Find any buffer for a file which has same truename.
|
16
|
57 (other (and (not buf)
|
0
|
58 (get-file-buffer filename)))
|
|
59 error)
|
|
60 ;; Let user know if there is a buffer with the same truename.
|
16
|
61 (when other
|
|
62 (or nowarn
|
|
63 (string-equal filename (buffer-file-name other))
|
|
64 (message "%s and %s are the same file"
|
|
65 filename (buffer-file-name other)))
|
|
66 ;; Optionally also find that buffer.
|
|
67 (when (or (and (boundp 'find-file-existing-other-name)
|
|
68 find-file-existing-other-name)
|
|
69 find-file-visit-truename)
|
|
70 (setq buf other)))
|
0
|
71 (if buf
|
|
72 (or nowarn
|
|
73 (verify-visited-file-modtime buf)
|
|
74 (cond ((not (file-exists-p filename))
|
|
75 (error "File %s no longer exists!" filename))
|
|
76 ((yes-or-no-p
|
|
77 (if (string= (file-name-nondirectory filename)
|
|
78 (buffer-name buf))
|
|
79 (format
|
|
80 (if (buffer-modified-p buf)
|
|
81 "File %s changed on disk. Discard your edits? "
|
|
82 "File %s changed on disk. Reread from disk? ")
|
|
83 (file-name-nondirectory filename))
|
|
84 (format
|
|
85 (if (buffer-modified-p buf)
|
|
86 "File %s changed on disk. Discard your edits in %s? "
|
|
87 "File %s changed on disk. Reread from disk into %s? ")
|
|
88 (file-name-nondirectory filename)
|
|
89 (buffer-name buf))))
|
|
90 (save-excursion
|
|
91 (set-buffer buf)
|
|
92 (revert-buffer t t)))))
|
|
93 (save-excursion
|
|
94 ;;; The truename stuff makes this obsolete.
|
|
95 ;;; (let* ((link-name (car (file-attributes filename)))
|
|
96 ;;; (linked-buf (and (stringp link-name)
|
|
97 ;;; (get-file-buffer link-name))))
|
|
98 ;;; (if (bufferp linked-buf)
|
|
99 ;;; (message "Symbolic link to file in buffer %s"
|
|
100 ;;; (buffer-name linked-buf))))
|
|
101 (setq buf (create-file-buffer filename))
|
|
102 ;; (set-buffer-major-mode buf)
|
|
103 (set-buffer buf)
|
|
104 (erase-buffer)
|
|
105 (if rawfile
|
|
106 (condition-case ()
|
16
|
107 (nnheader-insert-file-contents filename t)
|
0
|
108 (file-error
|
|
109 ;; Unconditionally set error
|
|
110 (setq error t)))
|
|
111 (condition-case ()
|
|
112 (insert-file-contents filename t)
|
|
113 (file-error
|
|
114 ;; Run find-file-not-found-hooks until one returns non-nil.
|
|
115 (or t ; (run-hook-with-args-until-success 'find-file-not-found-hooks)
|
|
116 ;; If they fail too, set error.
|
|
117 (setq error t)))))
|
|
118 ;; Find the file's truename, and maybe use that as visited name.
|
|
119 (setq buffer-file-truename truename)
|
|
120 (setq buffer-file-number number)
|
|
121 ;; On VMS, we may want to remember which directory in a search list
|
|
122 ;; the file was found in.
|
|
123 (and (eq system-type 'vax-vms)
|
|
124 (let (logical)
|
16
|
125 (when (string-match ":" (file-name-directory filename))
|
|
126 (setq logical (substring (file-name-directory filename)
|
|
127 0 (match-beginning 0))))
|
0
|
128 (not (member logical find-file-not-true-dirname-list)))
|
|
129 (setq buffer-file-name buffer-file-truename))
|
16
|
130 (when find-file-visit-truename
|
|
131 (setq buffer-file-name
|
|
132 (setq filename
|
|
133 (expand-file-name buffer-file-truename))))
|
0
|
134 ;; Set buffer's default directory to that of the file.
|
|
135 (setq default-directory (file-name-directory filename))
|
|
136 ;; Turn off backup files for certain file names. Since
|
|
137 ;; this is a permanent local, the major mode won't eliminate it.
|
16
|
138 (when (not (funcall backup-enable-predicate buffer-file-name))
|
|
139 (make-local-variable 'backup-inhibited)
|
|
140 (setq backup-inhibited t))
|
0
|
141 (if rawfile
|
|
142 nil
|
|
143 (after-find-file error (not nowarn)))))
|
|
144 buf)))
|
|
145
|
|
146 (fset 'nnheader-run-at-time 'nnheader-xmas-run-at-time)
|
|
147 (fset 'nnheader-cancel-timer 'nnheader-xmas-cancel-timer)
|
16
|
148 (fset 'nnheader-cancel-function-timers 'nnheader-xmas-cancel-function-timers)
|
0
|
149 (fset 'nnheader-find-file-noselect 'nnheader-xmas-find-file-noselect)
|
|
150
|
|
151 (provide 'nnheaderxm)
|
|
152
|
|
153 ;;; nnheaderxm.el ends here.
|