├── README.md ├── hn-core.lisp ├── hn.lisp ├── ncurses.lisp ├── save-core.lisp ├── user-settings.lisp └── utilities.lisp /README.md: -------------------------------------------------------------------------------- 1 | # Hacker News in the Terminal 2 | 3 | Written in Common Lisp, hackernews is a command-line application which displays the popular programming site in the terminal. 4 | 5 | ## Inspiration 6 | The inspiration for this came from the [hacker-top](http://www.catonmat.net/blog/follow-hacker-news-from-the-console/) program written in Python. 7 | 8 | My program doesn't work exactly like hacker-top. In addition to being written in Common Lisp instead of Python, the main differences are: 9 | 10 | * browse articles in the terminal using lynx 11 | * read comments and user profiles in the terminal 12 | * switch between the "front page" and "newest" articles without restarting the program 13 | 14 | ## Requirements 15 | I developed this on a Ubuntu machine. The requirements I know of are: 16 | 17 | * the lynx text based browser 18 | * sbcl (Steel Bank Common Lisp) 19 | * ncurses-dev (the ncurses library) 20 | 21 | ## Installation Instructions (Ubuntu) 22 | sudo apt-get install ncurses-dev sbcl lynx 23 | git clone git://github.com/chadbraunduin/hackernews.git 24 | cd hackernews 25 | sbcl --load save-core.lisp 26 | ./hackernews 27 | 28 | ## Installation Instructions (other *nix) 29 | *install ncurses-dev library, sbcl, and lynx* 30 | yum install ncurses-devel #install ncurses dev on Red Hat / Fedora 31 | git clone git://github.com/chadbraunduin/hackernews.git 32 | cd hackernews 33 | sbcl --load save-core.lisp 34 | ./hackernews 35 | 36 | ## Known Installation Issues 37 | 38 | You may get the following error while installing hackernews 39 | 40 | Could not open library 'libncurses.so': /usr/lib/libncurses.so: file too short. 41 | The fix is 42 | 43 | sudo mv /usr/lib/libncurses.so{,.bak} 44 | sudo ln -s /lib/libncurses.so.5 /usr/lib/libncurses.so 45 | 46 | 47 | ## Commands 48 | ### All pages 49 | use the arrow keys, page keys, home key, and end key to navigate items 50 | 51 | **q** - quit 52 | 53 | **b** - go back to a previous screen or page 54 | 55 | type in a username to view the user's profile 56 | 57 | ### Front and Newest pages 58 | **h** - go to the front page 59 | 60 | **n** - go to the newest page 61 | 62 | **r** - reload the current page 63 | 64 | **m** - more posts 65 | 66 | type in the post number to view it in lynx 67 | 68 | type in "c" plus the post number to view the comments for it 69 | 70 | ## Credits 71 | I use the [Unofficial Hacker News API](http://api.ihackernews.com/) developed by [Ronnie Roller](http://ronnieroller.com/) to gather the data. 72 | 73 | I also require the following libraries within the code: 74 | 75 | * asdf 76 | * drakma 77 | * cl-json 78 | * cl-ppcre 79 | * uffi 80 | * cl-ncurses 81 | 82 | ## Known issues 83 | Every once in a while the cl-json method that converts the raw data into a CL form blows up. The error message returned indicates that there is an invalid character within the data. Usually, this issue goes away within a couple of minutes. I haven't haven't taken the time to fully investigate it. 84 | 85 | Also, within the comments, the little ellipse character that appears after an edit is not displaying correctly. Not sure if it is getting mangled by the API in transmission or if it is something my code is doing. 86 | 87 | ## TODOS 88 | * Allow upvoting of posts and comments 89 | * Get this to work in Windows 90 | -------------------------------------------------------------------------------- /hn-core.lisp: -------------------------------------------------------------------------------- 1 | (require :asdf) 2 | (require :drakma) 3 | (require :cl-json) 4 | (require :cl-ppcre) 5 | (asdf:operate 'asdf:load-op :uffi) 6 | (require 'uffi) 7 | (asdf:oos 'asdf:load-op 'cl-ncurses) 8 | 9 | ;; main program 10 | (defun start-main () 11 | (load "ncurses.lisp")) 12 | -------------------------------------------------------------------------------- /hn.lisp: -------------------------------------------------------------------------------- 1 | 2 | ;; constants 3 | (defparameter *api-url* "http://api.ihackernews.com") 4 | (defparameter *front-page* "page") 5 | (defparameter *newly-submitted* "new") 6 | (defparameter *profile* "profile") 7 | (defparameter *post* "post") 8 | (defparameter *posts-per-page* 30) 9 | (defparameter *front-page-title* "Front Page") 10 | (defparameter *newest-page-title* "Newest") 11 | 12 | (defun hn-posts-url (page &optional next-id) 13 | (let ((base-url (format nil "~a/~a" *api-url* page))) 14 | (if next-id 15 | (format nil "~a/~a" base-url next-id) 16 | base-url))) 17 | 18 | (defun hn-news-url (&optional next-id) 19 | (hn-posts-url "page" next-id)) 20 | 21 | (defun newest-url (&optional next-id) 22 | (hn-posts-url "new" next-id)) 23 | 24 | (defun user-url (username) 25 | (format nil "~a/~a/~a" 26 | *api-url* 27 | *profile* 28 | username)) 29 | 30 | (defun comments-url (item-id) 31 | (format nil "~a/~a/~a" 32 | *api-url* 33 | *post* 34 | item-id)) 35 | 36 | (defstruct hn-page 37 | url 38 | (message nil) 39 | (title *front-page-title*) 40 | (scroll-pos 0) 41 | (total-lines-needed 0)) 42 | 43 | (defstruct (home-page (:include hn-page)) 44 | (items nil) 45 | (next-ids '()) 46 | (index 0)) 47 | 48 | (defstruct (user-page (:include hn-page)) 49 | user 50 | (back-page nil)) 51 | 52 | (defstruct (comments-page (:include hn-page)) 53 | text 54 | (comments nil) 55 | (back-page nil) 56 | (back-item nil)) 57 | 58 | (defstruct hn-item 59 | title 60 | url 61 | id 62 | comment-count 63 | points 64 | posted-ago 65 | posted-by 66 | (askhn? nil)) 67 | 68 | (defstruct hn-user 69 | username 70 | created-ago 71 | karma 72 | about 73 | version 74 | cached-on-+utc+) 75 | 76 | (defstruct hn-comment 77 | posted-by 78 | posted-ago 79 | comment 80 | id 81 | points 82 | parent-id 83 | post-id 84 | children 85 | (nesting-level 0)) 86 | 87 | ;; news page methods 88 | (defun askhnp (item) 89 | (let ((url (hn-item-url item))) 90 | (when (ppcre:scan "^/comments/\\d+" url) 91 | t))) 92 | 93 | (defun build-home-page (url &optional next-id page-index title) 94 | (let* ((page (make-home-page :url url)) 95 | (output (url-output (funcall (hn-page-url page) next-id))) 96 | (next-id (cdar output)) 97 | (raw-items (cdr (cadr output)))) 98 | (when (not (member next-id (home-page-next-ids page))) 99 | (setf (home-page-next-ids page) 100 | (cons next-id (home-page-next-ids page)))) 101 | (when page-index 102 | (setf (home-page-index page) page-index)) 103 | (when title 104 | (setf (hn-page-title page) title)) 105 | (setf (home-page-items page) (map 'vector 106 | (lambda 107 | (raw-item) 108 | (let ((item (apply #'make-hn-item raw-item))) 109 | (setf (hn-item-askhn? item) (askhnp item)) 110 | item)) 111 | (mapcar 112 | #'flatten-alist 113 | raw-items))) 114 | page)) 115 | 116 | (defun poster (username items) 117 | (let ((posters (remove-if-not 118 | (lambda (item) 119 | (string-equal username (hn-item-posted-by item))) 120 | (coerce items 'list)))) 121 | (when posters 122 | (car posters)))) 123 | 124 | (defun page-back (page) 125 | (let ((next-id (car (cdr (home-page-next-ids page)))) 126 | (new-page-index (1- (home-page-index page)))) 127 | (setf (home-page-next-ids page) (cdr (home-page-next-ids page))) 128 | (if (< new-page-index 0) 129 | page 130 | (build-home-page (hn-page-url page) next-id new-page-index)))) 131 | 132 | (defun page-forward (page) 133 | (let ((next-id (car (home-page-next-ids page))) 134 | (new-page-index (1+ (home-page-index page)))) 135 | (build-home-page (hn-page-url page) next-id new-page-index))) 136 | 137 | (defun validpostnumberp (post-number page) 138 | (let* ((page-index (home-page-index page)) 139 | (lower-post (* *posts-per-page* page-index)) 140 | (upper-post (+ *posts-per-page* lower-post))) 141 | (and (> post-number lower-post) 142 | (<= post-number upper-post)))) 143 | 144 | (defun get-item (post-number-str page) 145 | (let* ((post-number (parse-integer post-number-str)) 146 | (mod-post-number (mod post-number *posts-per-page*)) 147 | (adj-post-index (1- (if (zerop mod-post-number) 148 | *posts-per-page* 149 | mod-post-number)))) 150 | (aref (home-page-items page) adj-post-index))) 151 | 152 | (defun post-number (post-index page-index posts-per-page) 153 | (+ (1+ post-index) (* page-index posts-per-page))) 154 | 155 | ;; user page methods 156 | (defun build-user-page (username back-page) 157 | (let* ((url (user-url username)) 158 | (output (url-output url)) 159 | (user (apply #'make-hn-user (flatten-alist output)))) 160 | (make-user-page :url url :title username :user user :back-page back-page))) 161 | 162 | ;; comment page methods 163 | (defun build-comments (raw-comments nesting-level) 164 | (when raw-comments 165 | (let* ((comment (apply #'make-hn-comment 166 | (append (list :nesting-level nesting-level) 167 | (flatten-alist (car raw-comments))))) 168 | (children (hn-comment-children comment))) 169 | (append 170 | (cons 171 | comment 172 | (when children 173 | (let ((child-comments (build-comments children (1+ nesting-level)))) 174 | (setf (hn-comment-children comment) nil) 175 | child-comments))) 176 | (build-comments (cdr raw-comments) nesting-level))))) 177 | 178 | (defun build-comments-page (item &optional page-index back-page) 179 | (let* ((item-id (hn-item-id item)) 180 | (url (comments-url item-id)) 181 | (raw-output (url-output url)) 182 | (text (cdr (car raw-output))) 183 | (page (make-comments-page :url url 184 | :title (hn-item-title item) 185 | :text text 186 | :back-page back-page 187 | :back-item item)) 188 | (raw-comments (cdr (car (cdr raw-output))))) 189 | (when page-index 190 | (setf (comments-page-index page) page-index)) 191 | (setf (comments-page-comments page) (build-comments raw-comments 0)) 192 | page)) 193 | 194 | (defun commenter (username comments) 195 | (let ((commenters (remove-if-not 196 | (lambda (comment) 197 | (string-equal username (hn-comment-posted-by comment))) 198 | comments))) 199 | (when commenters 200 | (car commenters)))) 201 | 202 | ;; prepare data for the screen 203 | (defmethod title-str (page) 204 | (hn-page-title page)) 205 | 206 | (defmethod subtitle-str (page) "") 207 | 208 | (defun comments-page-id (page) 209 | (parse-integer (car (ppcre:all-matches-as-strings "\\d+$" (comments-page-url page))))) 210 | 211 | (defmethod subtitle-str ((page comments-page)) 212 | (let ((back-item (comments-page-back-item page)) 213 | (comment-count (length (comments-page-comments page)))) 214 | (format nil "~d | ~d points by ~a ~a | ~a" 215 | (comments-page-id page) 216 | (hn-item-points back-item) 217 | (hn-item-posted-by back-item) 218 | (hn-item-posted-ago back-item) 219 | (comment-count-str comment-count)))) 220 | 221 | (defgeneric printable-items (page curmaxx) 222 | (:documentation 223 | "prepare page items for printing to the screen")) 224 | 225 | (defun comment-count-str (count) 226 | (if (eq count 1) 227 | "1 comment" 228 | (format nil "~d comments" count))) 229 | 230 | (defmethod printable-items ((page home-page) curmaxx) 231 | (let ((items (home-page-items page))) 232 | (loop for item across items 233 | for n from 0 234 | collect (list 235 | (format nil "~d. ~a~a" 236 | (post-number n 237 | (home-page-index page) 238 | *posts-per-page*) 239 | (clean-html-str (hn-item-title item)) 240 | (if (hn-item-askhn? item) 241 | "" 242 | (format nil " \(~a\)" (clean-html-str (short-url item))))) 243 | (format nil "~d points by ~a ~a | ~a" 244 | (hn-item-points item) 245 | (hn-item-posted-by item) 246 | (hn-item-posted-ago item) 247 | (comment-count-str (hn-item-comment-count item))) 248 | "" ;; blank line for spacing 249 | )))) 250 | 251 | (defmethod printable-items ((page user-page) curmaxx) 252 | (let ((user (user-page-user page))) 253 | (list 254 | (append 255 | (list 256 | (format nil "user: ~a" (hn-user-username user)) 257 | (format nil "created: ~a" (hn-user-created-ago user)) 258 | (format nil "karma: ~d" (hn-user-karma user))) 259 | (word-wrap (concatenate 'string "about: " 260 | (clean-html-str (hn-user-about user))) 261 | 0 262 | curmaxx) 263 | (list "" ;; blank line for spacing 264 | ))))) 265 | 266 | (defmethod printable-items ((page comments-page) curmaxx) 267 | (let ((comments (comments-page-comments page))) 268 | (labels ((nesting-level-str (nesting-level) 269 | (apply 270 | #'concatenate 271 | 'string 272 | (loop repeat nesting-level collect " >>")))) 273 | (let ((text (comments-page-text page)) 274 | (print-comments 275 | (loop for comment in comments 276 | for nesting-level = (hn-comment-nesting-level comment) 277 | collect 278 | (append (when (> nesting-level 0) 279 | (list 280 | (format nil "~d~a" 281 | nesting-level 282 | (nesting-level-str nesting-level)))) 283 | (list 284 | (format nil "~a ~a" 285 | (hn-comment-posted-by comment) 286 | (hn-comment-posted-ago comment))) 287 | (word-wrap (clean-html-str (hn-comment-comment comment)) 288 | 0 289 | curmaxx) 290 | (list "" ;; blank line for spacing 291 | ))))) 292 | (if (not (string-equal text "")) 293 | (cons (list (clean-html-str text) 294 | "") 295 | print-comments) 296 | print-comments))))) 297 | 298 | (defmethod instructions-str (page) "") 299 | 300 | (defmethod instructions-str ((page home-page)) 301 | (format nil "[h]acker-news; [n]ewest; [r]eload-page; [m]ore-posts; [b]ack-page; [q]uit~% to read post; [c]+ to view comments; to view user")) 302 | 303 | (defmethod instructions-str ((page user-page)) 304 | (format nil "[b]ack; [q]uit")) 305 | 306 | (defmethod instructions-str ((page comments-page)) 307 | (format nil "[b]ack; [q]uit~%to view user")) 308 | 309 | ;; handle valid user commands 310 | (defun handle-default (cmd page) 311 | (cond 312 | ((equal cmd "") page) 313 | (t 314 | (setf (hn-page-message page) (format nil "~a is not a valid command" cmd)) 315 | page))) 316 | 317 | (defmethod handle-cmd (cmd page)) 318 | 319 | (defmethod handle-cmd (cmd (page home-page)) 320 | (let ((post (poster cmd (home-page-items page)))) 321 | (cond 322 | (post 323 | (build-user-page (hn-item-posted-by post) page)) ;; view user page 324 | ((equal cmd "h") 325 | (build-home-page #'hn-news-url)) ;; front page 326 | ((equal cmd "n") 327 | (build-home-page #'newest-url nil nil *newest-page-title*)) ;; newest posts 328 | ((equal cmd "r") 329 | (build-home-page (hn-page-url page))) ;; refresh items 330 | ((equal cmd "m") 331 | (page-forward page)) ;; more posts 332 | ((equal cmd "b") 333 | (page-back page)) ; back a page 334 | ((and (not (string-equal cmd "")) 335 | (integerlistp cmd) 336 | (validpostnumberp (parse-integer cmd) page)) 337 | (let* ((item (get-item cmd page)) 338 | (url (hn-item-url item)) 339 | (askhn? (hn-item-askhn? item))) 340 | (if askhn? ;; if item is "askHN", read the comments only 341 | (handle-cmd (concatenate 'string "c" cmd) page) 342 | (progn 343 | (browse url) 344 | page)))) ;; open a link 345 | ((and (not (string-equal cmd "")) 346 | (equal (char cmd 0) #\c) 347 | (integerlistp (subseq cmd 1)) 348 | (validpostnumberp (parse-integer (subseq cmd 1)) page)) 349 | (build-comments-page (get-item (subseq cmd 1) page) nil page)) ;; view comments 350 | (t (handle-default cmd page))))) 351 | 352 | (defmethod handle-cmd (cmd (page user-page)) 353 | (cond 354 | ((equal cmd "b") (user-page-back-page page)) ;; back 355 | (t (handle-default cmd page)))) 356 | 357 | (defmethod handle-cmd (cmd (page comments-page)) 358 | (let ((comment (commenter cmd (comments-page-comments page)))) 359 | (cond 360 | (comment (build-user-page (hn-comment-posted-by comment) page)) ;;view user page 361 | ((equal cmd "b") (comments-page-back-page page)) ;; back 362 | (t (handle-default cmd page))))) 363 | -------------------------------------------------------------------------------- /ncurses.lisp: -------------------------------------------------------------------------------- 1 | 2 | (declaim #+sbcl(sb-ext:muffle-conditions style-warning)) 3 | 4 | (in-package :cl-ncurses) 5 | 6 | ;; load other files 7 | (load "user-settings.lisp") 8 | (load "utilities.lisp") 9 | (load "hn.lisp") 10 | 11 | ;; initialize ncurses 12 | (initscr) 13 | (start-color) 14 | (assume-default-colors color_white color_black) ;;these two lines set the background black 15 | (cbreak) 16 | (noecho) 17 | 18 | ;; colors 19 | (defparameter *banner-color-number* 1) 20 | (init-pair *banner-color-number* color_black color_white) 21 | 22 | (defparameter *highlight-color-number* 2) 23 | (init-pair *highlight-color-number* color_cyan color_black) 24 | 25 | (defparameter *error-color-number* 3) 26 | (init-pair *error-color-number* color_white color_red) 27 | 28 | ;; windows and pads 29 | (defparameter bannerwin nil) 30 | (defparameter mypad nil) ;;scrolling area where the data goes 31 | (defparameter instrwin nil) 32 | (defparameter cmdwin nil) 33 | (defparameter hndlwin nil) 34 | 35 | ;; other globals 36 | (defparameter curmaxx 0) 37 | (defparameter curmaxy 0) 38 | 39 | ;; helper functions 40 | (defun pad-visible-lines () 41 | (- (getmaxy *stdscr*) 8)) 42 | (defun instrwiny () 43 | (- (getmaxy *stdscr*) 5)) 44 | (defun cmdwiny () 45 | (- (getmaxy *stdscr*) 2)) 46 | (defun hndlwiny () 47 | (- (getmaxy *stdscr*) 1)) 48 | 49 | (defun lines-needed (char-count max-width) 50 | (if (zerop char-count) 51 | 1 52 | (multiple-value-bind (q r) (truncate char-count max-width) 53 | (if (zerop r) 54 | q 55 | (1+ q))))) 56 | 57 | (defun pad-lines-needed (items max-width) 58 | (reduce #'+ 59 | (mapcar (lambda (item) 60 | (reduce #'+ 61 | (mapcar (lambda (str) (lines-needed (length str) max-width)) item))) 62 | items))) 63 | 64 | (defun build-screen (page &optional (text nil)) 65 | (clear) 66 | (refresh) 67 | (erase) ;; start by blanking out the screen 68 | ;; set current screen values 69 | (setf curmaxy (getmaxy *stdscr*)) 70 | (setf curmaxx (getmaxx *stdscr*)) 71 | 72 | ;; print banner and subtitle 73 | (setf bannerwin (newwin 4 curmaxx 0 0)) 74 | (wattron bannerwin (color-pair *banner-color-number*)) 75 | (mvwprintw bannerwin 1 0 (format nil "Hacker news - ~a" (title-str page))) 76 | (wattroff bannerwin (color-pair *banner-color-number*)) 77 | (mvwprintw bannerwin 2 0 (subtitle-str page)) 78 | 79 | ;; build pad 80 | (let* ((items (printable-items page curmaxx)) 81 | (total-lines-needed (pad-lines-needed items curmaxx))) 82 | (setf (hn-page-total-lines-needed page) total-lines-needed) 83 | (setf mypad (newpad total-lines-needed curmaxx)) 84 | (wattron mypad (color-pair *highlight-color-number*)) 85 | (loop for item in items 86 | do 87 | (loop for line in item 88 | do 89 | (loop for char across line 90 | do 91 | (waddch mypad (char-code char))) 92 | (waddch mypad (char-code #\newline)) 93 | )) 94 | (wattroff mypad (color-pair *highlight-color-number*))) 95 | 96 | ;; print instructions 97 | (setf instrwin (newwin 2 curmaxx (instrwiny) 0)) 98 | (wprintw instrwin (instructions-str page)) 99 | 100 | ;; command window 101 | (mvprintw (cmdwiny) 0 ">") 102 | (setf cmdwin (newwin 1 curmaxx (cmdwiny) 2)) 103 | (when text 104 | (wprintw cmdwin (text-to-str text))) ;; reposition the text back into the command bar 105 | 106 | ;; handle command window 107 | (setf hndlwin (newwin 1 curmaxx (hndlwiny) 0)) 108 | 109 | ;; refresh all windows and pads 110 | (refresh) 111 | (wrefresh bannerwin) 112 | (prefresh mypad (hn-page-scroll-pos page) 0 4 0 (pad-visible-lines) curmaxx) 113 | (wrefresh instrwin) 114 | (wrefresh cmdwin) 115 | (wrefresh hndlwin) 116 | 117 | ;; position the cursor 118 | (wmove cmdwin (getcury cmdwin) (getcurx cmdwin))) 119 | 120 | (defun print-error (text) 121 | (wclear hndlwin) 122 | (wattron hndlwin (color-pair *error-color-number*)) 123 | (wprintw hndlwin text) 124 | (wattroff hndlwin (color-pair *error-color-number*)) 125 | (wrefresh hndlwin)) 126 | 127 | (defun get-scroll-dir () 128 | (let ((ch (wgetch cmdwin))) 129 | (cond 130 | ((eq ch (char-code #\O)) ;; home and end keys 131 | (let ((ch (wgetch cmdwin))) 132 | (cond((eq ch (char-code #\H)) 'home) 133 | ((eq ch (char-code #\F)) 'end)))) 134 | ((eq ch (char-code #\[)) ;; arrow keys and whatnot 135 | (let ((ch (wgetch cmdwin))) 136 | (cond ((eq ch (char-code #\B)) 'down) 137 | ((eq ch (char-code #\A)) 'up) 138 | ((eq ch (char-code #\6)) 139 | (wgetch cmdwin) ;; clean off trailing ~ 140 | 'page-down) 141 | ((eq ch (char-code #\5)) 142 | (wgetch cmdwin) ;; clean off trailing ~ 143 | 'page-up))))))) 144 | 145 | (defun pad-scroll (page dir text) 146 | (let* ((total-lines-needed (hn-page-total-lines-needed page)) 147 | (scroll-pos (hn-page-scroll-pos page)) 148 | (end-position (- total-lines-needed 149 | (- (pad-visible-lines) 150 | (length (car (reverse (printable-items page curmaxx)))))))) 151 | (when (or (eq dir 'home) 152 | (eq dir 'end) 153 | (and (< scroll-pos end-position) 154 | (or (eq dir 'down) 155 | (eq dir 'page-down))) 156 | (and (> scroll-pos 0) 157 | (or (eq dir 'up) 158 | (eq dir 'page-up)))) 159 | (let ((dir-func (cond ((eq dir 'down) (lambda () (1+ scroll-pos))) 160 | ((eq dir 'page-down) (lambda () 161 | (let ((new-pos (+ scroll-pos (pad-visible-lines)))) 162 | (if (>= new-pos end-position) 163 | end-position 164 | new-pos)))) 165 | ((eq dir 'up) (lambda () (1- scroll-pos))) 166 | ((eq dir 'page-up) (lambda () 167 | (let ((new-pos (- scroll-pos (pad-visible-lines)))) 168 | (if (< new-pos 0) 169 | 0 170 | new-pos)))) 171 | ((eq dir 'home) (lambda () 0)) 172 | ((eq dir 'end) (lambda () end-position)) 173 | (t #'identity) 174 | ))) 175 | (setf (hn-page-scroll-pos page) (funcall dir-func))) 176 | ;; erase cruft at end of window by rebuilding the screen 177 | (let ((scroll-pos (hn-page-scroll-pos page))) 178 | (when (> (pad-visible-lines) (- total-lines-needed scroll-pos)) 179 | (build-screen page text)) 180 | (prefresh mypad scroll-pos 0 4 0 (pad-visible-lines) curmaxx))))) 181 | 182 | (defun main (page &optional (text nil)) 183 | (if (not (and (eq curmaxx (getmaxx *stdscr*)) 184 | (eq curmaxy (getmaxy *stdscr*)))) 185 | (progn 186 | (build-screen page text) 187 | (main page text)) ;; rebuild the screen if the terminal width or height changed 188 | (let ((ch (wgetch cmdwin))) 189 | (cond ((eq ch 27) ;; 27 is the escape code for arrow keys, home, end, and page keys 190 | (let ((y (getcury cmdwin)) 191 | (x (getcurx cmdwin)) 192 | (dir (get-scroll-dir))) 193 | (when dir 194 | (progn 195 | (funcall #'pad-scroll page dir text) 196 | (wmove cmdwin y x)))) 197 | (main page text)) ;; scrolling / paging 198 | ((eq ch (char-code #\newline)) 199 | (wclear cmdwin) 200 | (wclear hndlwin) 201 | (let ((cmd (text-to-str text))) 202 | (if (equal cmd "q") 203 | (endwin) ;; end the program 204 | (handler-case 205 | (progn 206 | (wclear cmdwin) 207 | (wclear hndlwin) 208 | (wprintw hndlwin "Loading...") 209 | (wrefresh hndlwin) 210 | (let* ((new-page (handle-cmd cmd page)) 211 | (message (hn-page-message page))) 212 | (build-screen new-page) 213 | (when message 214 | (print-error message) 215 | (setf (hn-page-message page) nil)) 216 | (main new-page))) 217 | (error (e) 218 | (progn 219 | (print-error (format nil "~S" e)) 220 | (main page)) 221 | ))))) ;; was clicked 222 | ((or (eq ch (char-code #\delete)) 223 | (eq ch (char-code #\backspace))) 224 | (let ((y (getcury cmdwin)) 225 | (x (getcurx cmdwin))) 226 | (mvwdelch cmdwin y (1- x))) 227 | (wrefresh cmdwin) 228 | (main page (cdr text))) ;; was clicked 229 | ((and (>= ch 32) 230 | (<= ch 126)) 231 | (waddch cmdwin ch) 232 | (wrefresh cmdwin) 233 | (main page (cons ch text))) ;; printable characters 234 | (t (main page text)) ;; anything else was clicked 235 | )))) 236 | 237 | ;; launch the application here 238 | (let ((page (build-home-page #'hn-news-url))) 239 | (build-screen page) 240 | (main page)) -------------------------------------------------------------------------------- /save-core.lisp: -------------------------------------------------------------------------------- 1 | (load "hn-core.lisp") 2 | (save-lisp-and-die "hackernews" :executable t :toplevel #'start-main) -------------------------------------------------------------------------------- /user-settings.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defparameter *browser-cmd* "/usr/bin/lynx") 3 | 4 | ;; future: username and password not currently used 5 | (defparameter *username* "chadbraunduin") 6 | (defparameter *password* nil) -------------------------------------------------------------------------------- /utilities.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defun run-cmd (cmd &rest args) 3 | (sb-ext:run-program cmd args :input t :output t :wait t)) 4 | 5 | (defun browse (url) 6 | (run-cmd *browser-cmd* 7 | "-accept_all_cookies " 8 | url)) 9 | 10 | (defun url-output (url) 11 | (let ((s (drakma:http-request url :want-stream t))) 12 | (json:decode-json-from-string (read-line s)))) 13 | 14 | (defun short-url (item) 15 | (let* ((without-front (ppcre:regex-replace 16 | "http[s]*://(www.)*" 17 | (hn-item-url item) 18 | "")) 19 | (short-url (ppcre:regex-replace 20 | "/.*" 21 | without-front 22 | ""))) 23 | short-url)) 24 | 25 | (defun clean-html-str (comment-str) 26 | (let* ((clean (ppcre:regex-replace "<[a-zA-Z]+.*?>" comment-str " ")) 27 | (clean (ppcre:regex-replace "" clean " ")) 28 | ) 29 | ;; a dirty hack to avoid the following fatal error 30 | ;; %n in writable segment detected 31 | (let ((pattern "%\\s*n")) 32 | (loop for match in (ppcre:all-matches-as-strings pattern clean) 33 | for whitespace = (repeat-char #\space (- (length match) 2)) 34 | do 35 | (setf clean (ppcre:regex-replace-all 36 | (format nil "%~an" whitespace) 37 | clean 38 | (format nil "%_~an" whitespace))))) 39 | (if (not (equal clean comment-str)) 40 | (clean-html-str clean) 41 | (string-trim " " clean)))) 42 | 43 | (defun repeat-char (char n) 44 | (coerce (loop repeat n 45 | collect char) 'string)) 46 | 47 | ;; not perfect but probably good enough for now 48 | (defun word-wrap (text start curmaxx &optional (acc nil)) 49 | (if (> (length text) start) 50 | ;; this "let" gets the potential line in question 51 | (let* ((right-padding 2) 52 | (curendx (+ start (- curmaxx right-padding))) 53 | (curendx (if (> curendx (length text)) 54 | (length text) 55 | curendx)) 56 | (line (subseq text start curendx))) 57 | ;; if we've reached the end of the text, exit the function returning all' 58 | ;; the lines in the correct order 59 | (if (and (< (- curendx start) (- curmaxx right-padding)) 60 | (>= (- curendx start) (length line))) 61 | (reverse (cons line acc)) 62 | ;; count how many characters it takes us to get to a space or newline 63 | ;; drop those characters down to the next line to be printed 64 | (let* ((adj-count (loop for c across (reverse line) 65 | until (or (eq c #\newline) 66 | (eq c #\space)) 67 | count c)) 68 | (adj-count (if (eq adj-count (length line)) 69 | 0 70 | adj-count)) 71 | (endx (if (> curmaxx (length line)) 72 | (length line) 73 | curmaxx)) 74 | (endx (- endx adj-count)) 75 | (adj-line (subseq line 0 endx))) 76 | (word-wrap text (+ start endx) curmaxx (cons adj-line acc))))) 77 | (reverse acc))) 78 | 79 | (defun flatten-alist (alist) 80 | (mapcan (lambda (x) (list (car x) (cdr x))) alist)) 81 | 82 | (defun integerlistp (list) 83 | (every #'digit-char-p list)) 84 | 85 | (defun text-to-str (text) 86 | (if text 87 | (map 'string #'code-char (reverse text)) 88 | "")) --------------------------------------------------------------------------------