summaryrefslogtreecommitdiff
path: root/share/emacs/site-lisp/w3m/w3m-proc.el
diff options
context:
space:
mode:
Diffstat (limited to 'share/emacs/site-lisp/w3m/w3m-proc.el')
-rw-r--r--share/emacs/site-lisp/w3m/w3m-proc.el801
1 files changed, 0 insertions, 801 deletions
diff --git a/share/emacs/site-lisp/w3m/w3m-proc.el b/share/emacs/site-lisp/w3m/w3m-proc.el
deleted file mode 100644
index fe76a52ed50..00000000000
--- a/share/emacs/site-lisp/w3m/w3m-proc.el
+++ /dev/null
@@ -1,801 +0,0 @@
-;;; w3m-proc.el --- Functions and macros to control sub-processes
-
-;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2007, 2008, 2009
-;; TSUCHIYA Masatoshi <tsuchiya@namazu.org>
-
-;; Authors: TSUCHIYA Masatoshi <tsuchiya@namazu.org>,
-;; Shun-ichi GOTO <gotoh@taiyo.co.jp>,
-;; Satoru Takabayashi <satoru-t@is.aist-nara.ac.jp>,
-;; Hideyuki SHIRAI <shirai@meadowy.org>,
-;; Keisuke Nishida <kxn30@po.cwru.edu>,
-;; Yuuichi Teranishi <teranisi@gohome.org>,
-;; Akihiro Arisawa <ari@mbf.sphere.ne.jp>,
-;; Katsumi Yamaoka <yamaoka@jpl.org>
-;; Keywords: w3m, WWW, hypermedia
-
-;; This file is a part of emacs-w3m.
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This module is a part of emacs-w3m which provides functions and
-;; macros to control sub-processes. Visit
-;; <URL:http://emacs-w3m.namazu.org/> for more details of emacs-w3m.
-
-;;; Code:
-
-(eval-when-compile
- (require 'cl))
-
-(require 'w3m-util)
-
-(eval-when-compile
- ;; Variable(s) which are used in the following inline functions.
- ;; They should be defined in the other module at run-time.
- (defvar w3m-current-url)
- (defvar w3m-current-buffer)
- (defvar w3m-current-process)
- (defvar w3m-profile-directory)
- (defvar w3m-terminal-coding-system)
- (defvar w3m-command)
- (defvar w3m-command-arguments)
- (defvar w3m-command-environment)
- (defvar w3m-async-exec)
- (defvar w3m-process-connection-type)
- (defvar w3m-process-modeline-format)
- (defvar w3m-work-buffer-list)
- (autoload 'w3m-idle-images-show-unqueue "w3m"))
-
-;; Silence the Emacs' byte-compiler that says ``might not be defined''.
-(eval-when-compile
- (defun w3m-decode-coding-string-with-priority (str coding)
- ()))
-
-(defvar w3m-process-inhibit-quit t
- "`w3m-process-sentinel' binds `inhibit-quit' according to this variable.")
-(defvar w3m-process-timeout 300
- "Number of seconds idle time waiting for processes to terminate.")
-(defvar w3m-process-kill-surely (featurep 'meadow)
- "If non-nil, kill the process surely.")
-
-(defconst w3m-process-max 5 "The maximum limit of the working processes.")
-(defvar w3m-process-queue nil "Queue of processes.")
-
-(defvar w3m-process-exit-status nil "The last exit status of a process.")
-(defvar w3m-process-authinfo-alist nil)
-(defvar w3m-process-accept-alist nil)
-
-(defvar w3m-process-user nil)
-(defvar w3m-process-passwd nil)
-(defvar w3m-process-realm nil)
-(defvar w3m-process-object nil)
-(make-variable-buffer-local 'w3m-process-user)
-(make-variable-buffer-local 'w3m-process-passwd)
-(make-variable-buffer-local 'w3m-process-realm)
-(make-variable-buffer-local 'w3m-process-object)
-
-(defvar w3m-process-modeline-string nil
- "Modeline string to show status of retrieving process.")
-(make-variable-buffer-local 'w3m-process-modeline-string)
-
-(defvar w3m-process-proxy-user nil "User name of the proxy server.")
-(defvar w3m-process-proxy-passwd nil "Password of the proxy server.")
-(defvar w3m-process-ssl-passphrase nil
- "Passphrase for the client certificate.")
-
-(defmacro w3m-process-with-coding-system (&rest body)
- "Set coding systems for `w3m-command', and evaluate BODY."
- `(let ((coding-system-for-read 'binary)
- (coding-system-for-write w3m-terminal-coding-system)
- (default-process-coding-system
- (cons 'binary w3m-terminal-coding-system))
- (process-connection-type w3m-process-connection-type))
- ,@body))
-(put 'w3m-process-with-coding-system 'lisp-indent-function 0)
-(put 'w3m-process-with-coding-system 'edebug-form-spec '(body))
-
-(defmacro w3m-process-with-environment (alist &rest body)
- "Set the environment variables according to ALIST, and evaluate BODY."
- `(let ((process-environment (copy-sequence process-environment))
- (temporary-file-directory
- (if (file-directory-p w3m-profile-directory)
- (file-name-as-directory w3m-profile-directory)
- ,(if (featurep 'xemacs)
- ;; Though `temporary-file-directory' exists even in XEmacs,
- ;; that's only an imitation provided by APEL.
- '(temp-directory)
- 'temporary-file-directory)))
- (default-directory
- (cond ((file-directory-p w3m-profile-directory)
- (file-name-as-directory w3m-profile-directory))
- ((file-directory-p (expand-file-name "~/"))
- (expand-file-name "~/"))
- (t temporary-file-directory))))
- ;; XEmacs obtains tmp-dir from the `temp-directory' function of which
- ;; return value can only be modified by the following env vars.
- ,@(if (featurep 'xemacs)
- '((setenv "TEMP" temporary-file-directory) ;; Windoze
- (setenv "TMPDIR" temporary-file-directory))) ;; Un|x
- (dolist (pair ,alist)
- (setenv (car pair) (cdr pair)))
- ,@body))
-(put 'w3m-process-with-environment 'lisp-indent-function 1)
-(put 'w3m-process-with-environment 'edebug-form-spec '(form body))
-
-(defun w3m-process-p (object)
- "Return t if OBJECT is a `w3m-process' object."
- (and (consp object)
- (vectorp (cdr object))
- (eq 'w3m-process-object (aref (cdr object) 0))))
-
-(put 'w3m-process-new 'edebug-form-spec '(form form form &optional form form))
-(defmacro w3m-process-new (command arguments buffer &optional process handlers)
- "Return a new `w3m-process' object."
- `(cons (cons ,command ,arguments)
- (vector 'w3m-process-object
- ,buffer
- ,process
- ,handlers)))
-
-(defmacro w3m-process-command (object)
- `(car (car ,object)))
-(defmacro w3m-process-arguments (object)
- `(cdr (car ,object)))
-(defmacro w3m-process-buffer (object)
- `(aref (cdr ,object) 1))
-(defmacro w3m-process-process (object)
- `(aref (cdr ,object) 2))
-(defmacro w3m-process-handlers (object)
- `(aref (cdr ,object) 3))
-
-(put 'w3m-process-handler-new 'edebug-form-spec '(form form form))
-(defmacro w3m-process-handler-new (buffer parent-buffer functions)
- `(vector ,buffer ,parent-buffer ,functions nil))
-(defmacro w3m-process-handler-buffer (handler)
- `(aref ,handler 0))
-(defmacro w3m-process-handler-parent-buffer (handler)
- `(aref ,handler 1))
-(defmacro w3m-process-handler-functions (handler)
- `(aref ,handler 2))
-(defmacro w3m-process-handler-result (handler)
- `(aref ,handler 3))
-
-(defun w3m-process-push (handler command arguments)
- "Generate a new `w3m-process' object which is provided by HANDLER,
-ARGUMENTS and this buffer, regist it to `w3m-process-queue', and
-return it."
- (let ((x (assoc (cons command arguments) w3m-process-queue)))
- (unless x
- (setq x (w3m-process-new command arguments (current-buffer)))
- (push x w3m-process-queue))
- (push (w3m-process-handler-new (current-buffer) w3m-current-buffer handler)
- (w3m-process-handlers x))
- (with-current-buffer (w3m-process-buffer x)
- (setq w3m-process-object x))))
-
-(defun w3m-process-kill-process (process)
- "Kill process PROCESS safely."
- (when (processp process)
- (set-process-filter process 'ignore)
- (set-process-sentinel process 'ignore)
- (when (memq (process-status process) '(run stop))
- (kill-process process)
- (when w3m-process-kill-surely
- (while (memq (process-status process) '(run stop))
- (sit-for 0.1))))))
-
-(defun w3m-process-start-process (object &optional no-sentinel)
- "Start a process specified by the OBJECT, return always nil.
-When NO-SENTINEL is not equal to nil, all status changes of the
-generated asynchronous process is ignored. Otherwise,
-`w3m-process-sentinel' is given to the process as the sentinel."
- (if (w3m-process-process object)
- (when no-sentinel
- (set-process-sentinel (w3m-process-process object) 'ignore))
- (with-current-buffer (w3m-process-buffer object)
- (w3m-process-with-coding-system
- (w3m-process-with-environment w3m-command-environment
- (let* ((command (w3m-process-command object))
- (proc (apply 'start-process command
- (current-buffer) command
- (w3m-process-arguments object)))
- (authinfo (when w3m-current-url
- (w3m-url-authinfo w3m-current-url)))
- (set-process-query-on-exit-flag
- (if (fboundp 'set-process-query-on-exit-flag)
- 'set-process-query-on-exit-flag
- 'process-kill-without-query)))
- (setq w3m-process-user (car authinfo)
- w3m-process-passwd (cdr authinfo)
- w3m-process-realm nil)
- (setf (w3m-process-process object) proc)
- (set-process-filter proc 'w3m-process-filter)
- (set-process-sentinel proc (if no-sentinel
- 'ignore
- 'w3m-process-sentinel))
- (funcall set-process-query-on-exit-flag proc nil))))))
- nil) ;; The return value of `w3m-process-start-process'.
-
-(defun w3m-process-kill-stray-processes ()
- "Kill stray processes."
- (dolist (obj w3m-process-queue)
- (unless (buffer-name (w3m-process-buffer obj))
- (setq w3m-process-queue (delq obj w3m-process-queue))
- (when (w3m-process-process obj)
- (w3m-process-kill-process (w3m-process-process obj))))))
-
-(defun w3m-process-start-queued-processes ()
- "Start a process which is registerd in `w3m-process-queue' if the
-number of current working processes is less than `w3m-process-max'."
- (w3m-process-kill-stray-processes)
- (let ((num 0))
- (catch 'last
- (dolist (obj (reverse w3m-process-queue))
- (when (buffer-name (w3m-process-buffer obj))
- (if (> (incf num) w3m-process-max)
- (throw 'last nil)
- (w3m-process-start-process obj)))))))
-
-(defun w3m-process-stop (buffer)
- "Remove handlers related to the buffer BUFFER, and stop processes
-which have no handler."
- (interactive (list (current-buffer)))
- (w3m-cancel-refresh-timer buffer)
- (setq w3m-process-queue
- (delq nil
- (mapcar
- (lambda (obj)
- (let ((handlers
- ;; List up handlers related to other buffer
- ;; than the buffer BUFFER.
- (delq nil
- (mapcar
- (lambda (handler)
- (unless (eq buffer
- (w3m-process-handler-parent-buffer
- handler))
- handler))
- (w3m-process-handlers obj)))))
- (if handlers
- (w3m-process-new
- (w3m-process-command obj)
- (w3m-process-arguments obj)
- (w3m-process-buffer obj)
- (w3m-process-process obj)
- (if (memq (w3m-process-buffer obj)
- (mapcar (lambda (x)
- (w3m-process-handler-buffer x))
- handlers))
- handlers
- (cons
- ;; Dummy handler to remove buffer.
- (w3m-process-handler-new
- (w3m-process-buffer obj)
- (w3m-process-handler-parent-buffer (car handlers))
- (lambda (x) (w3m-kill-buffer (current-buffer))))
- handlers)))
- (when (w3m-process-process obj)
- (w3m-process-kill-process (w3m-process-process obj)))
- (dolist (handler (w3m-process-handlers obj))
- (w3m-kill-buffer (w3m-process-handler-buffer handler)))
- nil)))
- w3m-process-queue)))
- (when (buffer-name buffer)
- (with-current-buffer buffer
- (setq w3m-current-process nil)))
- (w3m-process-start-queued-processes)
- (w3m-force-window-update-later buffer))
-
-(defun w3m-process-shutdown ()
- (let ((list w3m-process-queue))
- (setq w3m-process-queue nil
- w3m-process-authinfo-alist nil
- w3m-process-accept-alist nil)
- (dolist (obj list)
- (when (buffer-name (w3m-process-buffer obj))
- (when (w3m-process-process obj)
- (w3m-process-kill-process (w3m-process-process obj))))
- (w3m-kill-buffer (w3m-process-buffer obj)))))
-
-(defmacro w3m-process-with-null-handler (&rest body)
- "Generate the null handler, and evaluate BODY.
-When BODY is evaluated, the local variable `handler' keeps the null
-handler."
- (let ((var (gensym "--tempvar--")))
- `(let ((,var (let (handler) ,@body)))
- (when (w3m-process-p ,var)
- (w3m-process-start-process ,var))
- ,var)))
-(put 'w3m-process-with-null-handler 'lisp-indent-function 0)
-(put 'w3m-process-with-null-handler 'edebug-form-spec '(body))
-
-;; Error symbol:
-(put 'w3m-process-timeout 'error-conditions '(error w3m-process-timeout))
-(put 'w3m-process-timeout 'error-message "Time out")
-
-(defun w3m-process-error-handler (error-data process)
- (setq w3m-process-queue (delq process w3m-process-queue))
- (w3m-process-kill-process (w3m-process-process process))
- (signal (car error-data) (cdr error-data)))
-
-(defvar w3m-process-waited nil
- "Non-nil means that `w3m-process-with-wait-handler' is being evaluated.")
-
-(defun w3m-process-wait-process (process seconds)
- "Wait for SECONDS seconds or until PROCESS will exit.
-Returns the exit status of the PROCESS when it exit normally,
-otherwise returns nil."
- (catch 'timeout
- (let ((start (current-time)))
- (while (or (and (prog2
- (discard-input)
- (not (save-current-buffer (sit-for 0.1)))
- (discard-input))
- ;; Some input is detected but it may be a key
- ;; press event which should be ignored when the
- ;; process is not running.
- (memq (process-status process) '(open run)))
- (memq (process-status process) '(open run stop)))
- (and seconds
- (< seconds (w3m-time-lapse-seconds start (current-time)))
- (throw 'timeout nil)))
- (process-exit-status process))))
-
-(defmacro w3m-process-with-wait-handler (&rest body)
- "Generate the waiting handler, and evaluate BODY.
-When BODY is evaluated, the local variable `handler' keeps the handler
-which will wait for the end of the evaluation."
- (let ((result (gensym "--result--"))
- (wait-function (gensym "--wait-function--")))
- `(let ((w3m-process-waited t)
- (,result)
- (,wait-function (make-symbol "wait-function")))
- (fset ,wait-function 'identity)
- (setq ,result (let ((handler (list ,wait-function))) ,@body))
- (while (w3m-process-p ,result)
- (condition-case error
- (let (w3m-process-inhibit-quit inhibit-quit)
- ;; No sentinel function is registered and the process
- ;; sentinel function is called from this macro, in
- ;; order to avoid the dead-locking which occurs when
- ;; this macro is called in the environment that
- ;; `w3m-process-sentinel' is evaluated.
- (w3m-process-start-process ,result t)
- (unless (w3m-process-wait-process (w3m-process-process ,result)
- w3m-process-timeout)
- (w3m-process-error-handler (cons 'w3m-process-timeout nil)
- ,result)))
- (quit (w3m-process-error-handler error ,result)))
- (w3m-process-sentinel (w3m-process-process ,result) "finished\n" t)
- (setq ,result
- (catch 'result
- (dolist (handler (w3m-process-handlers ,result))
- (when (memq ,wait-function
- (w3m-process-handler-functions handler))
- (throw 'result (w3m-process-handler-result handler))))
- (w3m-process-error-handler (cons 'error
- "Can't find wait handler")
- ,result))))
- ,result)))
-(put 'w3m-process-with-wait-handler 'lisp-indent-function 0)
-(put 'w3m-process-with-wait-handler 'edebug-form-spec '(body))
-
-;;; Explanation of w3m-process-do in Japanese:
-;;
-;; w3m-process-do $B$O!"HsF14|=hM}$r4JC1$K=q$/$?$a$N%^%/%m$G$"$k!#Nc$($P!"(B
-;;
-;; (w3m-process-do
-;; (var (async-form...))
-;; post-body...)
-;;
-;; $B$H$$$&$h$&$K=q$/$H!"0J2<$N=g=x$G=hM}$,9T$o$l$k!#(B
-;;
-;; (1) async-form $B$rI>2A(B
-;; --> async-form $BFb$GHsF14|%W%m%;%9$,@8@.$5$l$?>l9g$O!"$=$NHsF1(B
-;; $B4|%W%m%;%9=*N;8e$K(B post-body $B$,I>2A$5$l$k$h$&$K!"%O%s%I%i(B
-;; $B$KDI2C(B
-;; --> $BHsF14|%W%m%;%9$,@8@.$5$l$J$+$C$?>l9g$O!"C1$K<!$N%9%F%C%W(B
-;; $B$K?J$`(B(= post-body $B$rI>2A$9$k(B)$B!#(B
-;; (2) post-body $B$rI>2A(B
-;;
-;; $B$J$*!"(Basync-form / post-body $B$,I>2A$5$l$k;~!"$=$NFbIt$GHsF14|%W%m%;(B
-;; $B%9$,@8@.$5$l$?>l9g$K!"$=$NJV$jCM$r=hM}$9$k$?$a$N%O%s%I%i$,!"JQ?t(B
-;; handler $B$K@_Dj$5$l$F$$$k!#HsF14|$J=hM}$r9T$&4X?t$r8F$S=P$9>l9g$K$O!"(B
-;; $B$=$N4X?t$N0z?t$H$7$FI,$:(B handler $B$rEO$5$J$1$l$P$J$i$J$$!#(B
-;;
-;; $B$^$?!"(Bw3m-process-do $B$O!"8=:_$N%O%s%I%i$NFbMF$rD4$Y$k$?$a!"$=$N%^%/(B
-;; $B%m$,8F$S=P$5$l$F$$$k4D6-$NJQ?t(B handler $B$r;2>H$9$k!#Nc$($P!"(B
-;;
-;; (let (handler) (w3m-process-do ...))
-;;
-;; $B$HJQ?t(B handler $B$r(B nil $B$KB+G{$7$F$*$/$H!"!V8=;~E@$N%O%s%I%i$O6u$G$"(B
-;; $B$k(B = $BHsF14|%W%m%;%9<B9T8e$KI,MW$J=hM}$OB8:_$7$J$$!W$H$$$&0UL#$K$J$j!"(B
-;; w3m-process-do() $B$O!"HsF14|%W%m%;%9$,@8@.$5$l$?>l9g$K$OC1$K(B nil $B$r(B
-;; $BJV$7!"$=$l0J30$N>l9g$O(B post-body $B$NCM$rJV$9!#(B
-;;
-(defmacro w3m-process-do (spec &rest body)
- "(w3m-process-do (VAR FORM) BODY...): Eval the body BODY asynchronously.
-If an asynchronous process is generated in the evaluation of the form
-FORM, this macro returns its object immdiately, and the body BODY will
-be evaluated after the end of the process with the variable VAR which
-is set to the result of the form FORM. Otherwise, the body BODY is
-evaluated at the same time, and this macro returns the result of the
-body BODY."
- (let ((var (or (car spec) (gensym "--tempvar--")))
- (form (cdr spec))
- (post-function (gensym "--post-function--")))
- `(let ((,post-function (lambda (,var) ,@body)))
- (let ((,var (let ((handler (cons ,post-function handler)))
- ,@form)))
- (if (w3m-process-p ,var)
- (if handler
- ,var
- (w3m-process-start-process ,var))
- (if (w3m-process-p (setq ,var (funcall ,post-function ,var)))
- (if handler
- ,var
- (w3m-process-start-process ,var))
- ,var))))))
-(put 'w3m-process-do 'lisp-indent-function 1)
-(put 'w3m-process-do 'edebug-form-spec '((symbolp form) def-body))
-
-(defmacro w3m-process-do-with-temp-buffer (spec &rest body)
- "(w3m-process-do-with-temp-buffer (VAR FORM) BODY...):
-Like `w3m-process-do', but the form FORM and the body BODY are
-evaluated in a temporary buffer."
- (let ((var (or (car spec) (gensym "--tempvar--")))
- (form (cdr spec))
- (post-body (gensym "--post-body--"))
- (post-handler (gensym "--post-handler--"))
- (temp-buffer (gensym "--temp-buffer--"))
- (current-buffer (gensym "--current-buffer--")))
- `(lexical-let ((,temp-buffer
- (w3m-get-buffer-create
- (generate-new-buffer-name w3m-work-buffer-name)))
- (,current-buffer (current-buffer)))
- (labels ((,post-body (,var)
- (when (buffer-name ,temp-buffer)
- (set-buffer ,temp-buffer))
- ,@body)
- (,post-handler (,var)
- (w3m-kill-buffer ,temp-buffer)
- (when (buffer-name ,current-buffer)
- (set-buffer ,current-buffer))
- ,var))
- (let ((,var (let ((handler
- (cons ',post-body (cons ',post-handler handler))))
- (with-current-buffer ,temp-buffer ,@form))))
- (if (w3m-process-p ,var)
- (if handler
- ,var
- (w3m-process-start-process ,var))
- (if (w3m-process-p
- (setq ,var (save-current-buffer
- (let ((handler (cons ',post-handler handler)))
- (,post-body ,var)))))
- (if handler
- ,var
- (w3m-process-start-process ,var))
- (,post-handler ,var))))))))
-(put 'w3m-process-do-with-temp-buffer 'lisp-indent-function 1)
-(put 'w3m-process-do-with-temp-buffer 'edebug-form-spec
- '((symbolp form) def-body))
-
-
-(defun w3m-process-start (handler command arguments)
- "Run COMMAND with ARGUMENTS, and eval HANDLER asynchronously."
- (if w3m-async-exec
- (w3m-process-do
- (exit-status (w3m-process-push handler command arguments))
- (w3m-process-start-after exit-status))
- (w3m-process-start-after
- (w3m-process-with-coding-system
- (w3m-process-with-environment w3m-command-environment
- (apply 'call-process command nil t nil arguments))))))
-
-(defun w3m-process-start-after (exit-status)
- (when w3m-current-buffer
- (with-current-buffer w3m-current-buffer
- (setq w3m-process-modeline-string nil)))
- (cond
- ((numberp exit-status)
- (zerop (setq w3m-process-exit-status exit-status)))
- ((not exit-status)
- (setq w3m-process-exit-status nil))
- (t
- (setq w3m-process-exit-status
- (string-as-multibyte (format "%s" exit-status)))
- nil)))
-
-(defvar w3m-process-background nil
- "Non-nil means that an after handler is being evaluated.")
-
-(defun w3m-process-sentinel (process event &optional ignore-queue)
- ;; Ensure that this function will be never called repeatedly.
- (set-process-sentinel process 'ignore)
- (let ((inhibit-quit w3m-process-inhibit-quit)
- (w3m-process-background t))
- (unwind-protect
- (if (buffer-name (process-buffer process))
- (with-current-buffer (process-buffer process)
- (w3m-static-unless (featurep 'xemacs)
- (accept-process-output process 1))
- (setq w3m-process-queue
- (delq w3m-process-object w3m-process-queue))
- (let ((exit-status (process-exit-status process))
- (buffer (current-buffer))
- (realm w3m-process-realm)
- (user w3m-process-user)
- (passwd w3m-process-passwd)
- (obj w3m-process-object))
- (setq w3m-process-object nil)
- (dolist (x (w3m-process-handlers obj))
- (when (and
- (buffer-name (w3m-process-handler-buffer x))
- (buffer-name (w3m-process-handler-parent-buffer x)))
- (set-buffer (w3m-process-handler-buffer x))
- (unless (eq buffer (current-buffer))
- (insert-buffer-substring buffer))))
- (dolist (x (w3m-process-handlers obj))
- (when (and
- (buffer-name (w3m-process-handler-buffer x))
- (buffer-name (w3m-process-handler-parent-buffer x)))
- (set-buffer (w3m-process-handler-buffer x))
- (let ((w3m-process-exit-status)
- (w3m-current-buffer
- (w3m-process-handler-parent-buffer x))
- (handler
- (w3m-process-handler-functions x))
- (exit-status exit-status))
- (when realm
- (w3m-process-set-authinfo w3m-current-url
- realm user passwd))
- (while (and handler
- (not (w3m-process-p
- (setq exit-status
- (funcall (pop handler)
- exit-status))))))
- (setf (w3m-process-handler-result x) exit-status))))))
- ;; Something wrong has been occured.
- (catch 'last
- (dolist (obj w3m-process-queue)
- (when (eq process (w3m-process-process obj))
- (setq w3m-process-queue (delq obj w3m-process-queue))
- (throw 'last nil)))))
- (delete-process process)
- (unless ignore-queue
- (w3m-process-start-queued-processes)))))
-
-(defun w3m-process-filter (process string)
- (when (buffer-name (process-buffer process))
- (with-current-buffer (process-buffer process)
- (let ((buffer-read-only nil)
- (case-fold-search nil))
- (goto-char (process-mark process))
- (insert string)
- (set-marker (process-mark process) (point))
- (unless (string= "" string)
- (goto-char (point-min))
- (cond
- ((and (looking-at
- "\\(?:Accept [^\n]+\n\\)*\\([^\n]+: accept\\? \\)(y/n)")
- (= (match-end 0) (point-max)))
- ;; SSL certificate
- (message "")
- (let ((yn (w3m-process-y-or-n-p w3m-current-url (match-string 1))))
- (ignore-errors
- (process-send-string process (if yn "y\n" "n\n"))
- (delete-region (point-min) (point-max)))))
- ((and (looking-at "\n?Accept unsecure SSL session:.*\n")
- (= (match-end 0) (point-max)))
- (delete-region (point-min) (point-max)))
- ((and (looking-at "\\(\n?Wrong username or password\n\\)?\
-Proxy Username for \\(?:.*\\): Proxy Password: ")
- (= (match-end 0) (point-max)))
- (when (or (match-beginning 1)
- (not (stringp w3m-process-proxy-passwd)))
- (setq w3m-process-proxy-passwd
- (read-passwd "Proxy Password: ")))
- (ignore-errors
- (process-send-string process
- (concat w3m-process-proxy-passwd "\n"))
- (delete-region (point-min) (point-max))))
- ((and (looking-at "\\(\n?Wrong username or password\n\\)?\
-Proxy Username for \\(.*\\): ")
- (= (match-end 0) (point-max)))
- (when (or (match-beginning 1)
- (not (stringp w3m-process-proxy-user)))
- (setq w3m-process-proxy-user
- (read-from-minibuffer (concat
- "Proxy Username for "
- (match-string 2) ": "))))
- (ignore-errors
- (process-send-string process
- (concat w3m-process-proxy-user "\n"))))
- ((and (looking-at "\\(\n?Wrong username or password\n\\)?\
-Username for [^\n]*\n?: Password: ")
- (= (match-end 0) (point-max)))
- (when (or (match-beginning 1)
- (not (stringp w3m-process-passwd)))
- (setq w3m-process-passwd
- (w3m-process-read-passwd w3m-current-url
- w3m-process-realm
- w3m-process-user
- (match-beginning 1))))
- (ignore-errors
- (process-send-string process
- (concat w3m-process-passwd "\n"))
- (delete-region (point-min) (point-max))))
- ((and (looking-at "\\(\n?Wrong username or password\n\\)?\
-Username for \\(.*\\)\n?: ")
- (= (match-end 0) (point-max)))
- (setq w3m-process-realm (w3m-decode-coding-string-with-priority
- (match-string 2) nil))
- (when (or (match-beginning 1)
- (not (stringp w3m-process-user)))
- (setq w3m-process-user
- (w3m-process-read-user w3m-current-url
- w3m-process-realm
- (match-beginning 1))))
- (ignore-errors
- (process-send-string process
- (concat w3m-process-user "\n"))))
- ((and (looking-at "Enter PEM pass phrase:")
- (= (match-end 0) (point-max)))
- (unless (stringp w3m-process-ssl-passphrase)
- (setq w3m-process-ssl-passphrase
- (read-passwd "PEM pass phrase: ")))
- (ignore-errors
- (process-send-string process
- (concat w3m-process-ssl-passphrase "\n"))
- (delete-region (point-min) (point-max))))
- ((progn
- (or (search-forward "\nW3m-current-url:" nil t)
- (goto-char (process-mark process)))
- (re-search-backward
- "^W3m-\\(?:in-\\)?progress: \\([.0-9]+/[.0-9]+[a-zA-Z]?b\\)$"
- nil t))
- (let ((str (w3m-process-modeline-format (match-string 1)))
- (buf))
- (save-current-buffer
- (dolist (handler (w3m-process-handlers w3m-process-object))
- (when (setq buf (w3m-process-handler-parent-buffer handler))
- (if (buffer-name buf)
- (progn
- (set-buffer buf)
- (setq w3m-process-modeline-string str))
- (w3m-process-kill-stray-processes)))))))))))))
-
-(defun w3m-process-modeline-format (str)
- (ignore-errors
- (cond
- ((stringp w3m-process-modeline-format)
- (format w3m-process-modeline-format
- (if (string-match "/0\\([a-zA-Z]?b\\)\\'" str)
- (replace-match "\\1" t nil str)
- str)))
- ((functionp w3m-process-modeline-format)
- (funcall w3m-process-modeline-format str)))))
-
-;; w3m-process-authinfo-alist has an association list as below format.
-;; (("root1" ("realm11" ("user11" . "pass11")
-;; ("user12" . "pass12"))
-;; ("realm12" ("user13" . "pass13")))
-;; ("root2" ("realm21" ("user21" . "pass21"))))
-(defun w3m-process-set-authinfo (url realm username password)
- (let (x y z (root (w3m-get-server-hostname url)))
- (if (setq x (assoc root w3m-process-authinfo-alist))
- (if (setq y (assoc realm x))
- (if (setq z (assoc username y))
- ;; Change a password only.
- (setcdr z password)
- ;; Add a pair of a username and a password.
- (setcdr y (cons (cons username password) (cdr y))))
- ;; Add a 3-tuple of a realm, a username and a password.
- (setcdr x (cons (cons realm (list (cons username password)))
- (cdr x))))
- ;; Add a 4-tuple of a server root, a realm, a username and a password.
- (push (cons root (list (cons realm (list (cons username password)))))
- w3m-process-authinfo-alist))))
-
-(defun w3m-process-read-user (url &optional realm ignore-history)
- "Read a user name for URL and REALM."
- (let* ((root (when (stringp url) (w3m-get-server-hostname url)))
- (ident (or realm root))
- (alist))
- (if (and (not ignore-history)
- (setq alist
- (cdr (assoc realm
- (cdr (assoc root
- w3m-process-authinfo-alist))))))
- (if (= 1 (length alist))
- (caar alist)
- (completing-read (if ident
- (format "Select username for %s: " ident)
- "Select username: ")
- (mapcar (lambda (x) (cons (car x) (car x))) alist)
- nil t))
- (read-from-minibuffer (if ident
- (format "Username for %s: " ident)
- "Username: ")))))
-
-(defun w3m-process-read-passwd (url &optional realm username ignore-history)
- "Read a password for URL, REALM, and USERNAME."
- (let* ((root (when (stringp url) (w3m-get-server-hostname url)))
- (ident (or realm root))
- (pass (cdr (assoc username
- (cdr (assoc realm
- (cdr (assoc root
- w3m-process-authinfo-alist))))))))
- (if (and pass (not ignore-history))
- pass
- (read-passwd (format (if ident
- (format "Password for %s%%s: " ident)
- "Password%s: ")
- (if (and (stringp pass)
- (> (length pass) 0)
- (not (featurep 'xemacs)))
- (concat " (default "
- (make-string (length pass) ?\*)
- ")")
- ""))
- nil pass))))
-
-(defun w3m-process-y-or-n-p (url prompt)
- "Ask user a \"y or n\" question. Return t if answer is \"y\".
-NOTE: This function is designed to avoid annoying questions. So when
-the same questions is reasked, its previous answer is reused without
-prompt."
- (let ((root (w3m-get-server-hostname url))
- (map (copy-keymap query-replace-map))
- elem answer)
- ;; ignore [space] to avoid answering y without intention.
- (define-key map " " 'ignore)
- (let ((query-replace-map map))
- (if (setq elem (assoc root w3m-process-accept-alist))
- (if (member prompt (cdr elem))
- ;; When the same question has been asked, the previous
- ;; answer is reused.
- (setq answer t)
- ;; When any question for the same server has been asked,
- ;; regist the pair of this question and its answer to
- ;; `w3m-process-accept-alist'.
- (when (setq answer (y-or-n-p prompt))
- (setcdr elem (cons prompt (cdr elem)))))
- ;; When no question for the same server has been asked, regist
- ;; the 3-tuple of the server, the question and its answer to
- ;; `w3m-process-accept-alist'.
- (when (setq answer (y-or-n-p prompt))
- (push (cons root (list prompt)) w3m-process-accept-alist)))
- answer)))
-
-;; Silence the byte compiler complaining against `gensym' like:
-;; "Warning: the function `gensym' might not be defined at runtime."
-(eval-when-compile
- (and (boundp 'byte-compile-unresolved-functions)
- (fboundp 'gensym)
- (symbol-file 'gensym)
- (string-match "/cl-macs\\.el[^/]*\\'" (symbol-file 'gensym))
- (condition-case nil
- (setq byte-compile-unresolved-functions
- (delq (assq 'gensym byte-compile-unresolved-functions)
- byte-compile-unresolved-functions))
- (error))))
-
-(provide 'w3m-proc)
-
-;;; w3m-proc.el ends here
View Lorry Controller Status