Skip to content

Commit

Permalink
extensions: tabs and other cleanup
Browse files Browse the repository at this point in the history
  • Loading branch information
Harshavardhana committed Apr 17, 2014
1 parent 4fcd3c8 commit 1c91da8
Show file tree
Hide file tree
Showing 19 changed files with 376 additions and 378 deletions.
8 changes: 4 additions & 4 deletions extensions/beep.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,8 +18,8 @@

(if (= (system "beep -f 1 -l 0 >> /dev/null 2>&1") 0)
(add-hook! ft-message-receive-hook
(lambda (time from nickname message)
(system "beep -f 600 -l 10; beep -f 800 -l 10; beep -f 200 -l 10&")))
(lambda (time from nickname message)
(system "beep -f 600 -l 10; beep -f 800 -l 10; beep -f 200 -l 10&")))
(add-hook! ft-message-receive-hook
(lambda (time from nickname message)
(ft-beep 200 20))))
(lambda (time from nickname message)
(ft-beep 200 20))))
16 changes: 8 additions & 8 deletions extensions/broadcast.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -29,15 +29,15 @@
" Broadcast messages to all the roster "
(let ((online-buddies (list)))
(for-each (lambda (roster-item)
(and (cadr roster-item)
(set! online-buddies
(append online-buddies
(list (car roster-item))))))
(ft-get-roster-list))
(and (cadr roster-item)
(set! online-buddies
(append online-buddies
(list (car roster-item))))))
(ft-get-roster-list))
(if (> (string-length message) 0)
(send-messages-to-all online-buddies
message)
(ft-display (_ "usage: /broadcast [MESSAGE]")))))
(send-messages-to-all online-buddies
message)
(ft-display (_ "usage: /broadcast [MESSAGE]")))))

(add-command! /broadcast "/broadcast" "/broadcast [MESSAGE]" "Send messages to all buddies")
(add-command! /broadcast "*" "* [MESSAGE]" "Send messages to all the buddies")
92 changes: 46 additions & 46 deletions extensions/color.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,23 +45,23 @@
(define (ignore-message! pattern)
"ignore messages matching the pattern"
(set! ignored-msg-pattern-list
(cons pattern ignored-msg-pattern-list)))
(cons pattern ignored-msg-pattern-list)))

(define (ignored-message? message)
"tell if this message has to be ignored"
(letrec
((local-ignored-message?
(lambda (pattern-list message)
(if (= (length pattern-list) 0)
#f
(if (= (length pattern-list) 1)
(regexp-match? (string-match
(car pattern-list) message))
(if (regexp-match? (string-match
(car pattern-list) message))
#t
(local-ignored-message?
(cdr pattern-list) message)))))))
(lambda (pattern-list message)
(if (= (length pattern-list) 0)
#f
(if (= (length pattern-list) 1)
(regexp-match? (string-match
(car pattern-list) message))
(if (regexp-match? (string-match
(car pattern-list) message))
#t
(local-ignored-message?
(cdr pattern-list) message)))))))
(local-ignored-message? ignored-msg-pattern-list message)))


Expand All @@ -71,27 +71,27 @@
"specify color for buddies"
(if (assoc buddy auto-color-list)
(set! auto-color-list
(delete (cons
buddy
(cdr (assoc buddy auto-color-list)))
auto-color-list)))
(delete (cons
buddy
(cdr (assoc buddy auto-color-list)))
auto-color-list)))
(set! auto-color-list
(append auto-color-list
(list (cons buddy color)))))
(append auto-color-list
(list (cons buddy color)))))

(define (get-buddy-color buddy)
(if (assoc buddy auto-color-list)
'()
(begin
(set! auto-color-list
(append
auto-color-list
(list (cons
buddy
(car (list-ref color-list
(modulo
(length auto-color-list)
(length color-list))))))))))
(set! auto-color-list
(append
auto-color-list
(list (cons
buddy
(car (list-ref color-list
(modulo
(length auto-color-list)
(length color-list))))))))))
(cdr (assoc buddy auto-color-list)))

(define (color-message msg color)
Expand All @@ -106,25 +106,25 @@
(if (ignored-message? msg)
(ft-hook-return)
(if (equal? enable-colors-flag "yes")
(begin
(if (get-buddy-color from)
(begin
(ft-display
(string-append
(if (> (string-length timestamp) 0)
(color-message (string-append "[" timestamp "] ")
(get-buddy-color from))
(color-message (strftime "%I:%M%p " (localtime (current-time)))
(get-buddy-color from)))
(color-message (if (> (string-length nickname) 0)
nickname
from)
(get-buddy-color from))
(if (string-prefix? "/me " msg)
(color-message (substring msg 3) (get-buddy-color from))
(color-message (string-append " -> " msg) (get-buddy-color from))
)))
(ft-hook-return)))))))
(begin
(if (get-buddy-color from)
(begin
(ft-display
(string-append
(if (> (string-length timestamp) 0)
(color-message (string-append "[" timestamp "] ")
(get-buddy-color from))
(color-message (strftime "%I:%M%p " (localtime (current-time)))
(get-buddy-color from)))
(color-message (if (> (string-length nickname) 0)
nickname
from)
(get-buddy-color from))
(if (string-prefix? "/me " msg)
(color-message (substring msg 3) (get-buddy-color from))
(color-message (string-append " -> " msg) (get-buddy-color from))
)))
(ft-hook-return)))))))

(add-hook! ft-message-receive-hook append-color)

Expand Down
31 changes: 15 additions & 16 deletions extensions/connection.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,12 +20,12 @@

(define (connect-handle ret)
(cond ((= ret 0) #t)
((= ret -6) (ft-display (_ "Already connected")))
((= ret -1) (ft-display (_ "Server not set")))
((= ret -2) (ft-display (_ "JID not set")))
((= ret -3) (ft-display (_ "SSL support not available")))
((= ret -5) (ft-display (_ "Proxy Server not set")))
(else (ft-display (string-append (_ "Error, could not connect : ")
((= ret -6) (ft-display (_ "Already connected")))
((= ret -1) (ft-display (_ "Server not set")))
((= ret -2) (ft-display (_ "JID not set")))
((= ret -3) (ft-display (_ "SSL support not available")))
((= ret -5) (ft-display (_ "Proxy Server not set")))
(else (ft-display (string-append (_ "Error, could not connect : ")
(number->string ret))))))

(define (set-if-not-empty! set-fn! var default-var)
Expand All @@ -34,7 +34,7 @@
(if (string=? var "")
#f
(and (set-fn! var)
#t)))
#t)))

(define (read-line-clean)
(sans-surrounding-whitespace (read-line)))
Expand All @@ -45,7 +45,6 @@
(define (domain->server domain)
(cond ((string=? domain "jabber.org") "jabber.org")
((string=? domain "facebook.com") "chat.facebook.com")
((string=? domain "fb.com") "chat.facebook.com")
((string=? domain "chat.facebook.com") "chat.facebook.com")
(else domain)))

Expand Down Expand Up @@ -132,8 +131,8 @@
(and
(if (> (ft-get-conn-status) 0)
(begin
(ft-display (_ "Already Logged in. /disconnect first"))
#f))
(ft-display (_ "Already Logged in. /disconnect first"))
#f))
(read-jid)
(read-password)
(read-server)
Expand All @@ -142,12 +141,12 @@
(read-port)
(read-proxy)
(if (ft-get-proxy?)
(begin
(read-proxyserver)
(read-proxyport)
(read-proxyuname)
(read-proxypasswd)
""))
(begin
(read-proxyserver)
(read-proxyport)
(read-proxyuname)
(read-proxypasswd)
""))
(connect-handle (ft-connect))))
(add-command! /login "/login" "/login" "Interactive login to jabber server - blocking")

Expand Down
4 changes: 2 additions & 2 deletions extensions/dict-buddy.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,7 @@
(if (= (string-length args) 0)
(system "dict --help")
(begin
; (fh-set-current-target-buddy! "dict" "send")
(system (string-append "dict -P more \"" args "\"")))))
; (fh-set-current-target-buddy! "dict" "send")
(system (string-append "dict -P more \"" args "\"")))))

(add-command! /dict "/dict" "/dict [OPTIONS] [WORD]" "lookup in dictionary")
56 changes: 28 additions & 28 deletions extensions/dyn-commands.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,18 +24,18 @@
"Adds a dynamic command"
(if (procedure? func)
(set! dynamic-command-registry
(assoc-set! dynamic-command-registry
command
(list func syntax description)))
(assoc-set! dynamic-command-registry
command
(list func syntax description)))
(display (string-append (_ "freetalk: error: command [")
command
(_ "] not bound to any procedure\n")))))
command
(_ "] not bound to any procedure\n")))))

(define (remove-command! command)
"Removes a dynamic command"
(set! dynamic-command-registry
(assoc-remove! dynamic-command-registry
command)))
(assoc-remove! dynamic-command-registry
command)))

(define (dynamic-command-proc command args)
((lambda (cmd-entry)
Expand All @@ -48,28 +48,28 @@
(define (help args)
"display help message"
(let ((command-name (sans-surrounding-whitespace args))
(command-doc (assoc-ref dynamic-command-registry (sans-surrounding-whitespace args))))
(command-doc (assoc-ref dynamic-command-registry (sans-surrounding-whitespace args))))
(if (not (string-null? args))
(if (not (list? command-doc))
(display (_ "no such command\n"))
(display (string-append command-name
" - "
(cadr command-doc)
"\n\t"
(caddr command-doc)
"\n"
)))
(for-each (lambda (command-entry)
(display (string-append (car command-entry)
" - "
(caddr command-entry)
"\n\t"
(cadddr command-entry)
"\n"
)))
(sort dynamic-command-registry
(lambda (a b)
(string<? (car a) (car b))))))))
(if (not (list? command-doc))
(display (_ "no such command\n"))
(display (string-append command-name
" - "
(cadr command-doc)
"\n\t"
(caddr command-doc)
"\n"
)))
(for-each (lambda (command-entry)
(display (string-append (car command-entry)
" - "
(caddr command-entry)
"\n\t"
(cadddr command-entry)
"\n"
)))
(sort dynamic-command-registry
(lambda (a b)
(string<? (car a) (car b))))))))

(add-command! help "help" "help [COMMAND]" "show help")
(add-command! help "/help" "/help [COMMAND]" "show help")
50 changes: 25 additions & 25 deletions extensions/file-transfer.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,43 +22,43 @@
(if (= (string-length args) 0)
(ft-display (_ "No file to send"))
(begin
(split-discarding-char #\space
(sans-surrounding-whitespace args)
(lambda (id file)
(and (if (> (string-length id) 0)
#t
(begin
(display (_ "Bad ID\n"))
#f))
(if (> (string-length file) 0)
#t
(begin
(display (_ "Invalid filename\n"))
#f))
(ft-send-file id file)))))))
(split-discarding-char #\space
(sans-surrounding-whitespace args)
(lambda (id file)
(and (if (> (string-length id) 0)
#t
(begin
(display (_ "Bad ID\n"))
#f))
(if (> (string-length file) 0)
#t
(begin
(display (_ "Invalid filename\n"))
#f))
(ft-send-file id file)))))))

(add-command! /send-file "/send-file" "/send-file [USER@SERVER]" "send a file to a buddy")

;;; when a buddy sends a file, we handle it in this way
(define (/allow-file args)
"Allow a buddy to transfer file"
(split-discarding-char #\space
(sans-surrounding-whitespace args)
(lambda (cookie file)
(if (> (string-length cookie) 0)
(ft-set-allow-file (string->number cookie) file)
(ft-display (_ "Missing cookie number")))))
(sans-surrounding-whitespace args)
(lambda (cookie file)
(if (> (string-length cookie) 0)
(ft-set-allow-file (string->number cookie) file)
(ft-display (_ "Missing cookie number")))))
(remove-command! "/allow-file"))

(define (notify-file jid file errno cookie)
(if (= errno 1)
(begin
(add-command! /allow-file "/allow-file" "/allow-file" "Allow transfer of file from far end")
(ft-display (string-append "[" jid " wants to send file " file "]"))
(ft-display (string-append (_ "[use /allow-file ") (number->string cookie) (_ " [file-name] to accept]"))))
(add-command! /allow-file "/allow-file" "/allow-file" "Allow transfer of file from far end")
(ft-display (string-append "[" jid " wants to send file " file "]"))
(ft-display (string-append (_ "[use /allow-file ") (number->string cookie) (_ " [file-name] to accept]"))))
(begin
(if (= errno 2)
(ft-display (string-append "[" jid (_ " does not support IBB for file transfer]")))
(ft-display (string-append (_ "[failed to open file ") file "]"))))))
(if (= errno 2)
(ft-display (string-append "[" jid (_ " does not support IBB for file transfer]")))
(ft-display (string-append (_ "[failed to open file ") file "]"))))))

(add-hook! ft-notify-file-hook notify-file)
Loading

0 comments on commit 1c91da8

Please sign in to comment.