Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-mouse.el @ 26:441bb1e64a06 r19-15b96

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b96
author cvs
date Mon, 13 Aug 2007 08:51:32 +0200
parents 4103f0995bd7
children ec9a17fef872
comparison
equal deleted inserted replaced
25:383a494979f8 26:441bb1e64a06
182 (vm-mail-to-mailto-url url) 182 (vm-mail-to-mailto-url url)
183 (let ((browser (or browser vm-url-browser))) 183 (let ((browser (or browser vm-url-browser)))
184 (cond ((symbolp browser) 184 (cond ((symbolp browser)
185 (funcall browser url)) 185 (funcall browser url))
186 ((stringp browser) 186 ((stringp browser)
187 (vm-unsaved-message "Sending URL to %s..." browser) 187 (message "Sending URL to %s..." browser)
188 (vm-run-background-command browser url) 188 (vm-run-background-command browser url)
189 (vm-unsaved-message "Sending URL to %s... done" browser)))))) 189 (message "Sending URL to %s... done" browser))))))
190 190
191 (defun vm-mouse-send-url-to-netscape (url &optional new-netscape new-window) 191 (defun vm-mouse-send-url-to-netscape (url &optional new-netscape new-window)
192 (vm-unsaved-message "Sending URL to Netscape...") 192 (message "Sending URL to Netscape...")
193 (if new-netscape 193 (if new-netscape
194 (vm-run-background-command vm-netscape-program url) 194 (vm-run-background-command vm-netscape-program url)
195 (or (equal 0 (vm-run-command vm-netscape-program "-remote" 195 (or (equal 0 (vm-run-command vm-netscape-program "-remote"
196 (concat "openURL(" url 196 (concat "openURL(" url
197 (if new-window ", new-window" "") 197 (if new-window ", new-window" "")
198 ")"))) 198 ")")))
199 (vm-mouse-send-url-to-netscape url t new-window))) 199 (vm-mouse-send-url-to-netscape url t new-window)))
200 (vm-unsaved-message "Sending URL to Netscape... done")) 200 (message "Sending URL to Netscape... done"))
201 201
202 (defun vm-mouse-send-url-to-mosaic (url &optional new-mosaic new-window) 202 (defun vm-mouse-send-url-to-mosaic (url &optional new-mosaic new-window)
203 (vm-unsaved-message "Sending URL to Mosaic...") 203 (message "Sending URL to Mosaic...")
204 (if (null new-mosaic) 204 (if (null new-mosaic)
205 (let ((pid-file "~/.mosaicpid") 205 (let ((pid-file "~/.mosaicpid")
206 (work-buffer " *mosaic work*") 206 (work-buffer " *mosaic work*")
207 pid) 207 pid)
208 (cond ((file-exists-p pid-file) 208 (cond ((file-exists-p pid-file)
214 (insert (if new-window "newwin" "goto") ?\n) 214 (insert (if new-window "newwin" "goto") ?\n)
215 (insert url ?\n) 215 (insert url ?\n)
216 ;; newline convention used should be the local 216 ;; newline convention used should be the local
217 ;; one, whatever that is. 217 ;; one, whatever that is.
218 (setq buffer-file-type nil) 218 (setq buffer-file-type nil)
219 (and (fboundp 'set-file-coding-system) 219 (and (vm-xemacs-mule-p)
220 (set-file-coding-system 'no-conversion nil)) 220 (set-file-coding-system 'no-conversion nil))
221 (write-region (point-min) (point-max) 221 (write-region (point-min) (point-max)
222 (concat "/tmp/Mosaic." pid) 222 (concat "/tmp/Mosaic." pid)
223 nil 0) 223 nil 0)
224 (set-buffer-modified-p nil) 224 (set-buffer-modified-p nil)
226 (cond ((or (null pid) 226 (cond ((or (null pid)
227 (not (equal 0 (vm-run-command "kill" "-USR1" pid)))) 227 (not (equal 0 (vm-run-command "kill" "-USR1" pid))))
228 (setq new-mosaic t))))) 228 (setq new-mosaic t)))))
229 (if new-mosaic 229 (if new-mosaic
230 (vm-run-background-command vm-mosaic-program url)) 230 (vm-run-background-command vm-mosaic-program url))
231 (vm-unsaved-message "Sending URL to Mosaic... done")) 231 (message "Sending URL to Mosaic... done"))
232 232
233 233
234 (defun vm-mouse-install-mouse () 234 (defun vm-mouse-install-mouse ()
235 (cond ((vm-mouse-xemacs-mouse-p) 235 (cond ((vm-mouse-xemacs-mouse-p)
236 (if (null (lookup-key vm-mode-map 'button2)) 236 (if (null (lookup-key vm-mode-map 'button2))
251 251
252 ;; return t on zero exit status 252 ;; return t on zero exit status
253 ;; return (exit-status . stderr-string) on nonzero exit status 253 ;; return (exit-status . stderr-string) on nonzero exit status
254 (defun vm-run-command-on-region (start end output-buffer command 254 (defun vm-run-command-on-region (start end output-buffer command
255 &rest arg-list) 255 &rest arg-list)
256 (let ((tempfile nil) status errstring) 256 (let ((tempfile nil)
257 ;; for DOS/Windows command to tell it that its input is
258 ;; binary.
259 (binary-process-input t)
260 status errstring)
257 (unwind-protect 261 (unwind-protect
258 (progn 262 (progn
259 (setq tempfile (vm-make-tempfile-name)) 263 (setq tempfile (vm-make-tempfile-name))
260 (setq status 264 (setq status
261 (apply 'call-process-region 265 (apply 'call-process-region
262 start end command nil 266 start end command nil
263 (list output-buffer tempfile) 267 (list output-buffer tempfile)
264 nil arg-list)) 268 nil arg-list))
265 (cond ((equal status 0) t) 269 (cond ((equal status 0) t)
266 ((zerop (save-excursion 270 ;; even if exit status non-zero, if there was no
267 (set-buffer (find-file-noselect tempfile)) 271 ;; diagnostic output the command probablyt
268 (buffer-size))) 272 ;; succeeded. I have tried just use exit status
273 ;; as the failure criteria and users complained.
274 ((equal (nth 7 (file-attributes tempfile)) 0)
275 (message "%s exited non-zero (code %s)" command status)
269 t) 276 t)
270 (t (save-excursion 277 (t (save-excursion
278 (message "%s exited non-zero (code %s)" command status)
271 (set-buffer (find-file-noselect tempfile)) 279 (set-buffer (find-file-noselect tempfile))
272 (setq errstring (buffer-string)) 280 (setq errstring (buffer-string))
273 (kill-buffer nil) 281 (kill-buffer nil)
274 (cons status errstring))))) 282 (cons status errstring)))))
275 (vm-error-free-call 'delete-file tempfile)))) 283 (vm-error-free-call 'delete-file tempfile))))