一个很有名的浏览器

源代码在线查看: user-hooks.scm

软件大小: 3632 K
上传用户: zp380747972
关键词: 浏览器
下载地址: 免注册下载 普通下载 VIP

相关代码

				;;; USER CODE								(use-modules (ice-9 optargs)		;let-optional					     (ice-9 regex)					     (srfi srfi-2)		;and-let*					     (srfi srfi-8)		;receive					     (srfi srfi-13)		;string-lib					     )												;;; goto-url-hooks				;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;				;;; Handle search URLs								;; Makes a searcher routine.  If the routine is called without any				;; arguments, return the home page location.  Otherwise, construct a				;; URL searching for the arguments specified.				;; e.g.				;;  (define f (make-searcher "http://www.google.com/"				;;                           "http://www.google.com/search?q="				;;                           "&btnG=Google%20Search"))				;;  (f '())				;;   => "http://www.google.com/"				;;  (f '("google" "me"))				;;   => "http://www.google.com/search?q=google%20me&btnG=Google%20Search"				(define (make-searcher home-page prefix . maybe-postfix)				  (let-optional maybe-postfix ((postfix ""))				    (lambda (words)				      (if (null? words)					  home-page					  (string-append prefix (string-join words "%20") postfix)))))								;; TODO: ,gg -> gg: format update to the standard ELinks one. --pasky								(define goto-url-searchers				  `((",gg"   . ,(make-searcher "http://www.google.com/"							       "http://www.google.com/search?q=" "&btnG=Google%20Search"))				    (",fm"   . ,(make-searcher "http://www.freshmeat.net/"							       "http://www.freshmeat.net/search/?q="))				    (",dict" . ,(make-searcher "http://www.dictionary.com/"							       "http://www.dictionary.com/cgi-bin/dict.pl?db=%2A&term="))				    (",wtf"  . ,(make-searcher "http://www.ucc.ie/cgi-bin/acronym?wtf"							       "http://www.ucc.ie/cgi-bin/acronym?"))))								(add-hook! goto-url-hooks					   (lambda (url)					     (let* ((words (string-tokenize url))						    (key (car words))						    (rest (cdr words)))					       (cond ((assoc key goto-url-searchers) =>						      (lambda (x) ((cdr x) rest)))						     (else #f)))))												;;; goto-url-hooks				;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;				;;; Handle simple URLs								(define goto-url-simples				  `((",forecast" . "http://www.bom.gov.au/cgi-bin/wrap_fwo.pl?IDV10450.txt")				    (",local" . "XXXXXXXXXXXXXXXXXXX")				    ))								(add-hook! goto-url-hooks					   (lambda (url)					     (cond ((assoc url goto-url-simples) => cdr)						   (else #f))))												;;; goto-url-hooks				;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;				;;; Expand ~/ and ~user/ URLs								(define (home-directory . maybe-user)				  (let-optional maybe-user ((user (cuserid)))				    (and-let* ((user (catch 'misc-error							    (lambda () (getpwnam user))							    (lambda ignore #f))))					      (passwd:dir user))))								(define (expand-tilde-file-name file-name)				  (and (string-prefix? "~" file-name)				       (let* ((slash/end (or (string-index file-name #\/)							     (string-length file-name)))					      (user (substring file-name 1 slash/end)))					 (string-append (if user							    (home-directory)							    (home-directory user))							(substring file-name slash/end)))))								(add-hook! goto-url-hooks					   (lambda (url)					     (and (string-prefix? "~" url)						  (expand-tilde-file-name url))))												;;; pre-format-html-hooks				;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;				;;; Mangle linuxgames.com pages								(add-hook! pre-format-html-hooks					   (lambda (url html)					     (and (string-contains url "linuxgames.com")						  (and-let* ((start (string-contains html ""))							     (end (string-contains html "" (+ start 1))))							    (string-append (substring/shared html 0 start)									   (substring/shared html (+ end 10)))))))												;;; pre-format-html-hooks				;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;				;;; Mangle dictionary.com result pages								(add-hook! pre-format-html-hooks				  (lambda (url html)				    (and (string-contains url "dictionary.reference.com/search?")					 (and-let* ((m (string-match							(string-append							 ""							 ".*")							html)))					   (string-append "Dictionary.com lookup"							  ""							  (regexp-substitute/global #f							      "\n" (match:substring m 0)							    'pre "\n\n" 'post))))))												;;; get-proxy-hooks				;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;				;;; Some addresses require a special proxy 								(add-hook! get-proxy-hooks					   (lambda (url)					     (and (or (string-contains url "XXXXXXXXXXXXXX")						      (string-contains url "XXXXXXXXXXXXXX"))						  "XXXXXXXXXXXXXXXXXXXXXXXXXXX")))												;;; get-proxy-hooks				;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;				;;; Some addresses work better without a proxy								(add-hook! get-proxy-hooks					   (lambda (url)					     (and (or (string-contains url "XXXXXXXXXXXXXXXXXXX")						      (string-contains url "XXXXXXXXXX"))						  "")))												;;; quit-hooks				;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;				;;; Delete temporary files when quitting								(define temporary-files '())								(add-hook! quit-hooks					   (lambda ()					     (for-each delete-file temporary-files)))								;;; The end				;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;							

相关资源