;;; 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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;