diff options
Diffstat (limited to 'qkbox')
| -rw-r--r-- | qkbox/toot.scm | 68 | 
1 files changed, 31 insertions, 37 deletions
| diff --git a/qkbox/toot.scm b/qkbox/toot.scm index 6d83e92..57964b4 100644 --- a/qkbox/toot.scm +++ b/qkbox/toot.scm @@ -35,13 +35,7 @@    #:use-module ((sxml fold)                  #:select (foldt))    #:use-module ((sxml xpath) -                #:select (sxpath)) -  #:export (post -            timeline -            favourite -            unfavourite -            reblog -            unreblog)) +                #:select (sxpath)))  (define current-mastodon-host    (make-parameter (getenv "MASTODON_HOST"))) @@ -49,12 +43,12 @@  (define current-mastodon-access-token    (make-parameter (getenv "MASTODON_ACCESS_TOKEN"))) -(define* (post text -               #:key -               spoiler-text -               visibility -               sensitive? -               reply-to) +(define*-public (post text +                      #:key +                      spoiler-text +                      visibility +                      sensitive? +                      reply-to)    (define-values (res body)      (/api/v1/statuses #:status text                        #:spoiler-text spoiler-text @@ -125,13 +119,13 @@              (account-id account)              (account-acct account)))) -(define (status-public? status) +(define-public (status-public? status)    (eq? 'public (status-visibility status))) -(define* (display-status status -                         #:key -                         (port (current-output-port)) -                         display-cw?) +(define*-public (display-status status +                                #:key +                                (port (current-output-port)) +                                display-cw?)    (let ((account (status-account status)))      (format port "~s ~a ~a ~s~@[ ~:@(~a~)~]~%"              (fetch-avatar-static (account-avatar-static account)) @@ -152,19 +146,19 @@        (display-content (status-content status)                         port))))) -(define (status-id status) +(define-public (status-id status)    (assoc-ref (status-json status) "id")) -(define (status-account status) +(define-public (status-account status)    (make-account (assoc-ref (status-json status) "account"))) -(define (status-reblog status) +(define-public (status-reblog status)    (let ((reblog/json (assoc-ref (status-json status) "reblog")))      (if (eq? reblog/json 'null)          #f          (make-status reblog/json)))) -(define (status-content status) +(define-public (status-content status)    (assoc-ref (status-json status) "content"))  (define (content->sxml content) @@ -176,7 +170,7 @@                                'pre "<br/>" 'post)      "</status>"))) -(define* (display-content content #:optional (port (current-output-port))) +(define*-public (display-content content #:optional (port (current-output-port)))    (for-each (lambda (x) (display x port))              (flatten               (foldt (lambda (xs) @@ -196,31 +190,31 @@      (append-map flatten x))     (else (list x)))) -(define (status-visibility status) +(define-public (status-visibility status)    (string->symbol (assoc-ref (status-json status) "visibility"))) -(define (status-spoiler-text status) +(define-public (status-spoiler-text status)    (let ((s (assoc-ref (status-json status) "spoiler_text")))      (if (zero? (string-length s))          #f          s))) -(define (status-media-attachments status) +(define-public (status-media-attachments status)    (let ((v (assoc-ref (status-json status) "media_attachments")))      (if (zero? (vector-length v))          #f          (vector->list v)))) -(define (account-id account) +(define-public (account-id account)    (assoc-ref (account-json account) "id")) -(define (account-avatar-static account) +(define-public (account-avatar-static account)    (assoc-ref (account-json account) "avatar_static")) -(define (account-acct account) +(define-public (account-acct account)    (assoc-ref (account-json account) "acct")) -(define (account-display-name account) +(define-public (account-display-name account)    (assoc-ref (account-json account) "display_name"))  (define avatar-static-hash (make-hash-table)) @@ -253,7 +247,7 @@        (hash-set! avatar-static-hash url pict)        pict)))) -(define* (status id #:key (authorization? #t)) +(define*-public (status id #:key (authorization? #t))    (define-values (res body)      (/api/v1/statuses/:id id #:authorization? authorization?))    (case (response-code res) @@ -267,7 +261,7 @@     (format #f "/api/v1/statuses/~a" id)     #:authorization? authorization?)) -(define* (timeline #:key max-id since-id min-id limit local?) +(define*-public (timeline #:key max-id since-id min-id limit local?)    (define-values (res body)      (/api/v1/timelines/home #:max-id max-id                              #:since-id since-id @@ -294,7 +288,7 @@       ,@(if local? `((local . ,local?)) '()))     #:authorization? #t)) -(define (favourite id) +(define-public (favourite id)    (define-values (res body)      (/api/v1/statuses/:id/favourite id))    (case (response-code res) @@ -308,7 +302,7 @@     (format #f "/api/v1/statuses/~a/favourite" id)     #:authorization? #t)) -(define (unfavourite id) +(define-public (unfavourite id)    (define-values (res body)      (/api/v1/statuses/:id/unfavourite id))    (case (response-code res) @@ -322,7 +316,7 @@     (format #f "/api/v1/statuses/~a/unfavourite" id)     #:authorization? #t)) -(define (reblog id) +(define-public (reblog id)    (define-values (res body)      (/api/v1/statuses/:id/reblog id))    (case (response-code res) @@ -336,7 +330,7 @@     (format #f "/api/v1/statuses/~a/reblog" id)     #:authorization? #t)) -(define (unreblog id) +(define-public (unreblog id)    (define-values (res body)      (/api/v1/statuses/:id/unreblog id))    (case (response-code res) @@ -385,7 +379,7 @@          (values res (json-string->scm (utf8->string body)))          (values res body)))) -(define* (account id) +(define*-public (account id)    (define-values (res body)      (/api/v1/accounts/:id id))    (case (response-code res) | 
