cgit.sxemacs.org Git - gnus/blob - lisp/gnus-gl.el

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; GroupLens software and documentation is copyright (c) 1995 by Paul
   3 ;; Resnick (Massachusetts Institute of Technology); Brad Miller, John
   4 ;; Riedl, Jon Herlocker, and Joseph Konstan (University of Minnesota),
   5 ;; and David Maltz (Carnegie-Mellon University).
   6 ;;
   7 ;; Permission to use, copy, modify, and distribute this documentation
   8 ;; for non-commercial and commercial purposes without fee is hereby
   9 ;; granted provided that this copyright notice and permission notice
  10 ;; appears in all copies and that the names of the individuals and
  11 ;; institutions holding this copyright are not used in advertising or
  12 ;; publicity pertaining to this software without specific, written
  13 ;; prior permission.  The copyright holders make no representations
  14 ;; about the suitability of this software and documentation for any
  15 ;; purpose.  It is provided ``as is'' without express or implied
  16 ;; warranty.
  17 ;;
  18 ;; The copyright holders request that they be notified of
  19 ;; modifications of this code.  Please send electronic mail to
  20 ;; grouplens@cs.umn.edu for more information or to announce derived
  21 ;; works.
  22 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  23 ;; Author: Brad Miller
  24 ;;
  25 ;; $Id: gnus-gl.el,v 1.2 1996/02/25 03:46:03 steve Exp $
  26 ;;
  27 ;;
  28 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  29 ;;
  30 ;; User Documentation:
  31 ;; To use GroupLens you must load this file.
  32 ;; You must also register a pseudonym with the Better Bit Bureau.
  33 ;; http://www.cs.umn.edu/Research/GroupLens
  34 ;;
  35 ;;    ---------------- For your .emacs or .gnus file ----------------
  36 ;;
  37 ;; As of version 2.5, grouplens now works as a minor mode of
  38 ;; gnus-summary-mode.  To get make that work you just need a couple of
  39 ;; hooks.
  40 ;; In addition, there are a few gnus-*-hooks that need to be set:
  41 ;; (add-hook 'gnus-startup-hook 'bbb-login)
  42 ;; (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode)
  43 ;;
  44 ;; If you want to see grouplens scores using our format you might want to
  45 ;; add a %uG to the gnus-summary-line-format.  For example, I use:
  46 ;; (setq gnus-summary-line-format "%U%R%uG%I%(%[%4L: %-20,20uB%]%) %s\n")
  47 ;; The above format also assumes that you are using gnus-bbdb  You can
  48 ;; just as easily ad %uG to whatever format string you use.  Or add
  49 ;; a %i to just see a simple numeric version of the predictions that
  50 ;; uses less space on the summary line.  If you use %uG you have several
  51 ;; choices for how things look.  See the doc string for the
  52 ;; grouplens-prediction-display variable.
  53 ;; (setq grouplens-prediction-display 'prediction-bar)
  54 ;;
  55 ;; If you use %uI on your group-line-format you will get (GroupLens Enhanced)
  56 ;; after the names of newsgroups supported by GroupLens.
  57 ;; (setq gnus-group-line-format "%M%S%p%5y: %(%g%) %uI\n")
  58 ;;
  59 ;; (setq gnus-summary-default-score 0)
  60 ;;
  61 ;; In addition there are some GroupLens user variables to set
  62 ;; (setq grouplens-pseudonym "foobar")
  63 ;; If you are using a bbb other than twain.cs.umn.edu you will need to
  64 ;; set the grouplens-bbb-host variable, and possibly the
  65 ;; grouplens-bbb-port variable.
  66 ;;
  67 ;;(setq grouplens-newsgroups '("comp.lang.c++" "rec.humor" "rec.food.recipes"))
  68 ;; This sets up the groups for which you will get predictions and ratings.
  69 ;;
  70 ;;                              USING GROUPLENS
  71 ;; How do I Rate an article??
  72 ;;   Before you type n to go to the next article, hit a number from 1-5
  73 ;;   Type V r in the summary buffer and you will be prompted.
  74 ;;
  75 ;; What if, Gasp, I find a bug???
  76 ;; Please type M-x gnus-gl-submit-bug-report.  This will set up a
  77 ;; mail buffer with the  state of variables and buffers that will help
  78 ;; me debug the problem.  A short description up front would help too!
  79 ;;
  80 ;; How do I display the prediction for an aritcle:
  81 ;;  If you set the gnus-summary-line-format as shown above, the score
  82 ;;  (prediction) will be shown automatically.
  83 ;;
  84 ;;
  85 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  86 ;; Programmer  Notes
  87 ;; 10/9/95
  88 ;; gnus-scores-articles contains the articles
  89 ;; When scoring is done, the call tree looks something like:
  90 ;; gnus-possibly-score-headers
  91 ;;  ==> gnus-score-headers
  92 ;;      ==> gnus-score-load-file
  93 ;;          ==> get-all-mids  (from the eval form)
  94 ;;
  95 ;; it would be nice to have one that gets called after all the other
  96 ;; headers have been scored.
  97 ;; we may want a variable gnus-grouplens-scale-factor
  98 ;; and gnus-grouplens-offset  this would probably be either -3 or 0
  99 ;; to make the scores centered around zero or not.
 100 ;; Notes 10/12/95
 101 ;; According to Lars, Norse god of gnus, the simple way to insert a
 102 ;; call to an external function is to have a function added to the
 103 ;; variable gnus-score-find-files-function  This new function
 104 ;; gnus-grouplens-score-alist will return a core alist that
 105 ;; has (("message-id" ("<message-id-xxxx>" score) ("<message-id-xxxy>" score))
 106 ;; This seems like it would be pretty inefficient, though workable.
 107 ;;
 108 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 109 ;;  TODO
 110 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 111 ;;
 112 ;; 3. Add some more ways to rate messages
 113 ;; 4. Better error handling for token timeouts.
 114 ;;
 115 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 116 ;; bugs
 117 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 118 ;;
 119
 120 (require 'gnus-score)
 121 (eval-when-compile (require 'cl))
 122 (require 'cl)
 123
 124 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 125 ;;;; User variables
 126 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 127
 128 (defvar gnus-summary-grouplens-line-format
 129   "%U%R%z%l%I%(%[%4L: %-20,20n%]%) %s\n"
 130   "*The line format spec in summary GroupLens mode buffers.")
 131
 132 (defvar grouplens-pseudonym ""
 133   "User's pseudonym.  This pseudonym is obtained during the registration process")
 134
 135 (defvar grouplens-bbb-host "grouplens.cs.umn.edu"
 136   "Host where the bbbd is running" )
 137
 138 (defvar grouplens-bbb-port 9000
 139   "Port where the bbbd is listening" )
 140
 141 (defvar grouplens-newsgroups
 142   '("comp.lang.c++" "rec.humor" "rec.food.recipes" "comp.groupware"
 143     "mn.general" "rec.arts.movies" "rec.arts.movies.current-films"
 144     "comp.lang.java")
 145   "*Groups that are part of the GroupLens experiment.")
 146
 147 (defvar grouplens-prediction-display 'prediction-spot
 148   "valid values are:
 149       prediction-spot -- an * corresponding to the prediction between 1 and 5,
 150       confidence-interval -- a numeric confidence interval
 151       prediction-bar --  |#####     | the longer the bar, the better the article,
 152       confidence-bar --  |  -----   } the prediction is in the middle of the bar,
 153       confidence-spot -- )  *       | the spot gets bigger with more confidence,
 154       prediction-num  --   plain-old numeric value,
 155       confidence-plus-minus  -- prediction +/i confidence")
 156
 157 (defvar grouplens-score-offset 0
 158   "Offset the prediction by this value.
 159    Setting this variable to -2 would have the following effect
 160    on grouplens scores:
 161    1   -->   -2
 162    2   -->   -1
 163    3   -->    0
 164    4   -->    1
 165    5   -->    2
 166
 167    the reason a user might want to do this is to combine grouplens
 168    predictions with scores calculated by other score methods"
 169 )
 170
 171 (defvar grouplens-score-scale-factor 1
 172    "This variable allow sthe user to magify the effect of
 173     grouplens scores. The scale factor is applied after
 174     the offset.")
 175
 176 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 177 ;;;; Program global variables
 178 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 179
 180
 181 (defvar grouplens-bbb-token "0"
 182   "Current session token number")
 183
 184 (defvar grouplens-bbb-process nil
 185   "Process Id of current bbbd network stream process")
 186
 187 (defvar grouplens-rating-alist nil
 188   "Current set of  message-id rating pairs")
 189
 190 (defvar grouplens-current-hashtable (make-hash-table :test 'equal :size 100))
 191 ;; this seems like a pretty ugly way to get around the problem, but If
 192 ;; I don't do this, then the compiler complains when I call gethash
 193 ;;
 194 (eval-when-compile (setq grouplens-current-hashtable
 195                          (make-hash-table :test 'equal :size 100)))
 196
 197 (defvar grouplens-current-group nil)
 198
 199 (defvar bbb-mid-list nil)
 200
 201 (defvar bbb-alist nil)
 202
 203 (defvar bbb-timeout-secs 10
 204   "Number of seconds to wait for some response from the BBB before
 205     we give up and assume that something has died..." )
 206
 207 (defvar starting-time nil)
 208
 209 (defvar elapsed-time 0)
 210
 211 (defvar previous-article nil)
 212
 213 (defvar process-buffer)
 214 (defvar bbb-read-point)
 215 (defvar bbb-response-point)
 216 (defvar login-response)
 217
 218 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 219 ;;;;  Utility Functions
 220 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 221 (defun connect-to-bbbd (host port)
 222   (setq process-buffer
 223         (get-buffer-create (format "trace of BBBD session to %s" host)))
 224   ;; clear the trace buffer of old output
 225   (save-excursion
 226     (set-buffer process-buffer)
 227     (erase-buffer))
 228   ;; open the connection to the server
 229   (setq grouplens-bbb-process nil)
 230   (catch 'done
 231     (condition-case error
 232         (setq grouplens-bbb-process
 233               (open-network-stream "BBBD" process-buffer host port))
 234       (error (gnus-message 3 "Error: Failed to connect to BBB")
 235              nil))
 236     (and (null grouplens-bbb-process) (throw 'done nil))
 237     (set-process-filter grouplens-bbb-process 'bbb-process-filter)
 238     (save-excursion
 239       (set-buffer process-buffer)
 240       (make-local-variable 'bbb-read-point)
 241       (setq bbb-read-point (point-min))
 242       (and (null (setq greeting (bbb-read-response grouplens-bbb-process t)))
 243            (throw 'done nil))
 244       ))
 245   grouplens-bbb-process )
 246
 247 (defun bbb-process-filter (process output)
 248   (save-excursion
 249     (set-buffer (process-buffer process))
 250     (goto-char (point-max))
 251     (insert output)))
 252
 253 (defun bbb-send-command (process command)
 254   (goto-char (point-max))
 255   (insert command "\r\n")
 256   (setq bbb-read-point (point))
 257   (setq bbb-response-point (point))
 258   (process-send-string process command)
 259   (process-send-string process "\r\n"))
 260
 261 ;; This function eats the initial response of OK or ERROR from
 262 ;; the BBB.
 263 (defun bbb-read-response (process &optional return-response-string)
 264   (let ((case-fold-search nil)
 265          match-end)
 266     (goto-char bbb-read-point)
 267     (while (and (not (search-forward "\r\n" nil t))
 268                 (accept-process-output process bbb-timeout-secs))
 269       (goto-char bbb-read-point))
 270     (setq match-end (point))
 271     (goto-char bbb-read-point)
 272     (if (not (looking-at "OK"))
 273         (progn (setq bbb-read-point match-end) nil)
 274       (setq bbb-read-point match-end)
 275       (if return-response-string
 276           (buffer-substring (point) match-end)
 277         t ))))
 278
 279 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 280 ;;;;       Login Functionons
 281 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 282 (defun bbb-login ()
 283   "return the token number if login is successful, otherwise return nil"
 284   (interactive)
 285   (if (not (equal grouplens-pseudonym ""))
 286       (let ((bbb-process (connect-to-bbbd grouplens-bbb-host grouplens-bbb-port)))
 287         (if bbb-process
 288             (save-excursion (set-buffer (process-buffer bbb-process))
 289                             (bbb-send-command bbb-process
 290                                               (concat "login " grouplens-pseudonym))
 291                             (if (setq login-response
 292                                       (bbb-read-response bbb-process t))
 293                                 (setq grouplens-bbb-token (extract-token-number))
 294                               (gnus-message 3 "Error: Grouplens login failed")
 295                               (setq grouplens-bbb-token "0")
 296                               nil))) )
 297     (gnus-message 3 "Error: you must set a pseudonym"))
 298     nil)
 299
 300 (defun extract-token-number ()
 301   (let ((token-pos (search-forward "token=" nil t) ))
 302     (if (looking-at "[0-9]+")
 303         (buffer-substring token-pos (match-end 0)))))
 304
 305 (defun bbb-logout ()
 306   "logout of bbb session"
 307   (let ((bbb-process (connect-to-bbbd grouplens-bbb-host grouplens-bbb-port)))
 308     (if bbb-process
 309         (save-excursion (set-buffer (process-buffer bbb-process))
 310                         (bbb-send-command bbb-process
 311                                           (concat "logout " grouplens-bbb-token))
 312                         (if (bbb-read-response bbb-process t)
 313                             t
 314                           nil) ))))
 315
 316 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317 ;;;;       Get Predictions
 318 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 319
 320 ;; this function can be called as part of the function
 321 ;; to return the list of score files to use.
 322 ;; See the gnus variable gnus-score-find-score-files-function
 323 ;; *Note:*  If you want to use grouplens scores along with
 324 ;; calculated scores, you should see the offset and scale variables.
 325 ;; At this point, I don't recommend using both scores and grouplens
 326 ;; predictions together.
 327 (defun bbb-build-mid-scores-alist (groupname)
 328   (if (member groupname grouplens-newsgroups)
 329       (let* ((mid-list (get-all-mids))
 330              (predict-list (bbb-get-predictions mid-list groupname)))
 331                                         ; alist should be a list of lists
 332                                         ; ((("message-id" ("<message-id>"
 333                                         ; score nil s)))
 334         (setq grouplens-current-group groupname)
 335         (setq previous-article nil)
 336         (list (list (list (append (list "message-id") predict-list)))))
 337     (progn (setq grouplens-current-group groupname)
 338            nil))
 339   )
 340
 341 ;; Ask the bbb for predictions, and build up the score alist.
 342 (defun bbb-get-predictions (midlist groupname)
 343   (if (equal grouplens-bbb-token "0")
 344       (gnus-message 3 "Error: You are not logged in to a BBB")
 345     (gnus-message 5 "Fetching Predictions...")
 346     (let* ((predict-command (build-predict-command
 347                              midlist groupname grouplens-bbb-token ))
 348            (predict-list nil)
 349            (bbb-process (connect-to-bbbd grouplens-bbb-host grouplens-bbb-port)))
 350       (if bbb-process
 351           (save-excursion (set-buffer (process-buffer bbb-process))
 352                           (bbb-send-command bbb-process predict-command)
 353                           (if (bbb-read-response bbb-process nil)
 354                               (setq predict-list
 355                                     (bbb-get-prediction-response bbb-process))
 356                             (gnus-message 1 "Invalid Token, login and try again")
 357                             (ding)
 358                             )))
 359       (setq bbb-alist predict-list))
 360     ))
 361
 362
 363
 364 (defun get-all-mids ()
 365   (let ((index (nth 1 (assoc "message-id" gnus-header-index)))
 366         (articles gnus-newsgroup-headers)
 367         art this)
 368     (setq bbb-mid-list nil)
 369     (while articles
 370       (progn (setq art (car articles)
 371                    this (aref art index)
 372                    articles (cdr articles))
 373              (setq bbb-mid-list (cons this bbb-mid-list))))
 374     bbb-mid-list)
 375   )
 376
 377 (defun build-predict-command (mlist grpname token)
 378   (let ((cmd (concat "getpredictions " token " " grpname "\r\n"))
 379         art)
 380     (while mlist
 381       (setq art (car mlist)
 382             cmd (concat cmd art "\r\n")
 383             mlist (cdr mlist)))
 384     (setq cmd (concat cmd ".\r\n"))
 385   cmd)
 386   )
 387
 388 (defun bbb-get-prediction-response (process)
 389   (let ((case-fold-search nil)
 390         match-end)
 391     (goto-char bbb-read-point)
 392     (while (and (not (search-forward ".\r\n" nil t))
 393                 (accept-process-output process bbb-timeout-secs))
 394       (goto-char bbb-read-point))
 395     (setq match-end (point))
 396     (goto-char (+ bbb-response-point 4))  ;; we ought to be right before OK
 397     (build-response-alist)))
 398
 399 ;; build-response-alist assumes that the cursor has been positioned at
 400 ;; the first line of the list of mid/rating pairs.  For now we will
 401 ;; use a prediction of 99 to signify no prediction.  Ultimately, we
 402 ;; should just ignore messages with no predictions.
 403 (defun build-response-alist ()
 404   (let ((resp nil)
 405         (match-end (point)))
 406     (setq grouplens-current-hashtable (make-hash-table :test 'equal :size 100))
 407     (while
 408         (cond ((looking-at "\\(<.*>\\) :nopred=")
 409                (setq resp (cons  (list (get-mid)
 410                                        gnus-summary-default-score
 411                                        nil 's) resp))
 412                (forward-line 1)
 413                t)
 414               ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\) :conflow=\\([0-9]\.[0-9][0-9]\\) :confhigh=\\([0-9]\.[0-9][0-9]\\)")
 415                (setq resp (cons  (list (get-mid) (get-pred) nil 's) resp))
 416                (cl-puthash (get-mid)
 417                            (list (get-pred) (get-confl) (get-confh))
 418                            grouplens-current-hashtable)
 419                (forward-line 1)
 420                t)
 421               ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\)")
 422                (setq resp (cons  (list (get-mid) (get-pred) nil 's) resp))
 423                (cl-puthash (get-mid)
 424                            (list (get-pred) 0 0)
 425                            grouplens-current-hashtable)
 426                (forward-line 1)
 427                t)
 428               (t nil) ))
 429     resp)
 430 )
 431
 432 ;; these two functions assume that there is an active match lying
 433 ;; around.  Where the first parenthesized expression is the
 434 ;; message-id, and the second is the prediction.  Since gnus assumes
 435 ;; that scores are integer values?? we round the prediction.
 436 (defun get-mid ()
 437   (buffer-substring (match-beginning 1) (match-end 1)))
 438
 439 (defun get-pred ()
 440   (let ((tpred (round (string-to-int (buffer-substring
 441                                       (match-beginning 2)
 442                                       (match-end 2))))))
 443     (if (> tpred 0)
 444         (* grouplens-score-scale-factor (+ grouplens-score-offset  tpred))
 445       1))
 446 )
 447
 448 (defun get-confl ()
 449   (string-to-number (buffer-substring (match-beginning 3) (match-end 3))))
 450
 451 (defun get-confh ()
 452   (string-to-number (buffer-substring (match-beginning 4) (match-end 4))))
 453
 454 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 455 ;;;;      Prediction Display
 456 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 457 (defconst rating-range 4.0)
 458 (defconst grplens-maxrating 5)
 459 (defconst grplens-minrating 1)
 460 (defconst grplens-predstringsize 12)
 461
 462 (defalias 'bbb-grouplens-score 'gnus-user-format-function-G)
 463
 464 (defvar gnus-tmp-score)
 465 (defun gnus-user-format-function-G (header)
 466   (let* ((rate-string (make-string 12 ? ))
 467          (mid
 468           (aref header
 469                 (nth 1 (assoc "message-id" gnus-header-index))))
 470          (hashent (gethash mid grouplens-current-hashtable))
 471          (iscore (if (string-match "September" gnus-version)
 472                     gnus-tmp-score
 473                   score))
 474          (low (car (cdr hashent)))
 475          (high (car (cdr (cdr hashent)))))
 476     (aset rate-string 0 ?|) (aset rate-string 11 ?|)
 477     (if (not (member grouplens-current-group grouplens-newsgroups))
 478         (progn
 479           (if (not (equal grouplens-prediction-display 'prediction-num))
 480               (cond ((< iscore 0)
 481                      (setq iscore 1))
 482                     ((> iscore 5)
 483                      (setq iscore 5))))
 484           (setq low 0) (setq high 0)))
 485     (if (and (grouplens-valid-score iscore)
 486              (not (null mid)))
 487         (cond
 488          ;; prediction-spot
 489          ((equal grouplens-prediction-display 'prediction-spot)
 490           (setq rate-string (fmt-prediction-spot rate-string iscore)))
 491          ;; confidence-interval
 492          ((equal grouplens-prediction-display 'confidence-interval)
 493           (setq rate-string (fmt-confidence-interval iscore low high)))
 494          ;; prediction-bar
 495          ((equal grouplens-prediction-display 'prediction-bar)
 496           (setq rate-string (fmt-prediction-bar rate-string iscore)))
 497          ;; confidence-bar
 498          ((equal grouplens-prediction-display 'confidence-bar)
 499           (setq rate-string (format "|   %4.2f   |" iscore)))
 500          ;; confidence-spot
 501          ((equal grouplens-prediction-display 'confidence-spot)
 502           (setq rate-string (format "|   %4.2f   |" iscore)))
 503          ;; prediction-num
 504          ((equal grouplens-prediction-display 'prediction-num)
 505           (setq rate-string (fmt-prediction-num iscore)))
 506          ;; confidence-plus-minus
 507          ((equal grouplens-prediction-display 'confidence-plus-minus)
 508                (setq rate-string (fmt-confidence-plus-minus iscore low high))
 509                )
 510          (t (gnus-message 3 "Invalid prediction display type"))
 511          )
 512       (aset rate-string 5 ?N) (aset rate-string 6 ?A))
 513     rate-string))
 514
 515 ;;
 516 ;; Gnus user format function that doesn't depend on
 517 ;; bbb-build-mid-scores-alist being used as the score function, but is
 518 ;; instead called from gnus-select-group-hook. -- LAB
 519 (defun gnus-user-format-function-L (header)
 520   (if (not (member grouplens-current-group grouplens-newsgroups))
 521       ;; Return an empty string
 522       ""
 523     (let* ((rate-string (make-string 12 ? ))
 524            (mid
 525             (aref header
 526                   (nth 1 (assoc "message-id" gnus-header-index))))
 527            (hashent (gethash mid grouplens-current-hashtable))
 528            (pred (nth 0 hashent))
 529            (low (nth 1 hashent))
 530            (high (nth 2 hashent)))
 531       (gnus-message 3 (concat "mid = " mid))
 532       ;; Init rate-string
 533       (aset rate-string 0 ?|)
 534       (aset rate-string 11 ?|)
 535
 536       ;; If no entry in BBB hash mark rate string as NA and return
 537       (if (null hashent)
 538           (progn
 539             (aset rate-string 5 ?N)
 540             (aset rate-string 6 ?A)
 541             rate-string)
 542         ;; Otherwise
 543         (cond
 544          ;; prediction-spot
 545          ((equal grouplens-prediction-display 'prediction-spot)
 546           (fmt-prediction-spot rate-string pred))
 547
 548          ;; confidence-interval
 549          ((equal grouplens-prediction-display 'confidence-interval)
 550           (fmt-confidence-interval pred low high))
 551
 552          ;; prediction-bar
 553          ((equal grouplens-prediction-display 'prediction-bar)
 554           (fmt-prediction-bar rate-string pred))
 555
 556          ;; confidence-bar
 557          ((equal grouplens-prediction-display 'confidence-bar)
 558           (format "|   %4.2f   |" pred))
 559
 560          ;; confidence-spot
 561          ((equal grouplens-prediction-display 'confidence-spot)
 562           (format "|   %4.2f   |" pred))
 563
 564          ;; prediction-num
 565          ((equal grouplens-prediction-display 'prediction-num)
 566           (fmt-prediction-num pred))
 567
 568          ;; confidence-plus-minus
 569          ((equal grouplens-prediction-display 'confidence-plus-minus)
 570           (fmt-confidence-plus-minus pred low high))
 571
 572          (t
 573           (gnus-message 3 "Invalid prediction display type")
 574           (aset rate-string 0 ?|)
 575           (aset rate-string 11 ?|)
 576           rate-string)
 577          )
 578         )
 579       )
 580     )
 581   )
 582
 583 (defun grouplens-valid-score (score)
 584   (if (equal grouplens-prediction-display 'prediction-num)
 585       t
 586     (and (>= score grplens-minrating)
 587          (<= score grplens-maxrating))))
 588
 589 (defun requires-confidence (format-type)
 590   (or (equal format-type 'confidence-plus-minus)
 591       (equal format-type 'confidence-spot)
 592       (equal format-type 'confidence-interval)))
 593
 594 (defun have-confidence (clow chigh)
 595   (not (or (null clow)
 596            (null chigh))))
 597
 598
 599 (defun fmt-prediction-spot (rate-string score)
 600   (aset rate-string
 601         (round (* (/ (- score grplens-minrating) rating-range)
 602                   (+ (- grplens-predstringsize 4) 1.49)))
 603         ?*)
 604   rate-string)
 605
 606 (defun fmt-confidence-interval (score low high)
 607   (if (have-confidence low high)
 608       (format "|%4.2f-%4.2f |" low high)
 609     (fmt-prediction-num score)))
 610
 611 (defun fmt-confidence-plus-minus (score low high)
 612   (if (have-confidence low high)
 613       (format "|%3.1f+/-%4.2f|" score (/ (- high low) 2.0))
 614     (fmt-prediction-num score)))
 615
 616 (defun fmt-prediction-bar (rate-string score)
 617   (let* ((i 1)
 618          (step (/ rating-range (- grplens-predstringsize 4)))
 619          (half-step (/ step 2))
 620          (loc (- grplens-minrating half-step)))
 621     (while (< i (- grplens-predstringsize 2))
 622       (if (> score loc)
 623           (aset rate-string i ?#)
 624         (aset rate-string i ? ))
 625       (setq i (+ i 1))
 626       (setq loc (+ loc step)))
 627     )
 628   rate-string)
 629
 630 (defun fmt-prediction-num (score)
 631   (format "|   %4.2f   |" score)
 632 )
 633 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 634 ;;;;       Put Ratings
 635 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 636
 637 ;; The message-id for the current article can be found in
 638 ;; (aref gnus-current-headers (nth 1 (assoc "message-id" gnus-header-index)))
 639 ;;
 640
 641 ;;
 642
 643 (defun bbb-put-ratings ()
 644   (if (and grouplens-rating-alist
 645            (member gnus-newsgroup-name grouplens-newsgroups))
 646       (let ((bbb-process (connect-to-bbbd grouplens-bbb-host
 647                                           grouplens-bbb-port))
 648             (rate-command (build-rate-command grouplens-rating-alist)))
 649         (if bbb-process
 650             (save-excursion (set-buffer (process-buffer bbb-process))
 651                             (gnus-message 5 "Sending Ratings...")
 652                             (bbb-send-command bbb-process rate-command)
 653                             (if (bbb-read-response bbb-process t)
 654                                 (setq grouplens-rating-alist nil)
 655                               (gnus-message 1
 656                             "Token timed out: call bbb-login and quit again")
 657                               (ding))
 658                             (gnus-message 5 "Sending Ratings...Done"))
 659           (gnus-message 3 "No BBB connection")))
 660     (setq grouplens-rating-alist nil))
 661 )
 662
 663 (defun build-rate-command (rate-alist)
 664   (let ((cmd (concat "putratings " grouplens-bbb-token
 665                      " " grouplens-current-group " \r\n"))
 666         this)
 667     (while rate-alist
 668       (setq this (car rate-alist)
 669             cmd (concat cmd (car this) " :rating=" (cadr this) ".00"
 670                         " :time=" (cddr this) "\r\n")
 671             rate-alist (cdr rate-alist)))
 672     (concat cmd ".\r\n"))
 673 )
 674
 675 ;; Interactive rating functions.
 676 (defun  bbb-summary-rate-article (rating &optional midin)
 677   (interactive "nRating: ")
 678   (let ((mid (or midin (get-current-id)))
 679         oldrating)
 680   (if (and rating (or (>  rating 0)
 681                       (<  rating 6))
 682            mid
 683            (member gnus-newsgroup-name grouplens-newsgroups))
 684       (progn
 685         (if (not (setq oldrating (assoc mid grouplens-rating-alist)))
 686             (setq grouplens-rating-alist (cons (cons mid (cons rating 0))
 687                                                grouplens-rating-alist))
 688           (setcdr oldrating (cons rating 0)))
 689         (gnus-summary-mark-article nil (int-to-string rating)))
 690     (gnus-message 3 "Invalid rating"))))
 691
 692 (defun grouplens-next-unread-article (rating)
 693   "Select unread article after current one."
 694   (interactive "P")
 695   (if rating
 696       (bbb-summary-rate-article rating))
 697   (gnus-summary-next-article t (and gnus-auto-select-same
 698                                     (gnus-summary-subject-string))))
 699
 700 (defun grouplens-best-unread-article (rating)
 701   "Select unread article after current one."
 702   (interactive "P")
 703   (if rating
 704       (bbb-summary-rate-article rating))
 705   (gnus-summary-best-unread-article))
 706
 707 (defun grouplens-score-thread-sept (score)
 708   "Raise the score of the articles in the current thread with SCORE."
 709   (interactive "nRating:")
 710   (let (e)
 711     (save-excursion
 712       (let ((articles (gnus-summary-articles-in-thread)))
 713         (while articles
 714           (gnus-summary-goto-subject (car articles))
 715           (gnus-set-global-variables)
 716           (bbb-summary-rate-article score
 717                             (mail-header-id
 718                              (gnus-summary-article-header (car articles))))
 719           (setq articles (cdr articles))))
 720       (setq e (point)))
 721     (let ((gnus-summary-check-current t))
 722       (or (zerop (gnus-summary-next-subject 1 t))
 723           (goto-char e))))
 724   (gnus-summary-recenter)
 725   (gnus-summary-position-point)
 726   (gnus-set-mode-line 'summary))
 727
 728 (defun grouplens-score-thread-v5 (score)
 729   "Raise the score of the articles in the current thread with SCORE."
 730   (interactive "nRating: ")
 731   (gnus-set-global-variables)
 732   (let ((scoring t)
 733         (level (gnus-summary-thread-level)))
 734     (save-excursion
 735       (while scoring
 736         (bbb-summary-rate-article score
 737                                   (mail-header-id
 738                                    (gnus-get-header-by-number
 739                                     (gnus-summary-article-number))))
 740         ;; ...and go forward until either the buffer ends or the subtree
 741         ;; ends.
 742         (if (not (and (zerop (forward-line 1))
 743                       (> (gnus-summary-thread-level) level)))
 744             (setq scoring nil))))
 745     ;; Go to next unread subject.
 746     (gnus-summary-next-subject 1 t))
 747   (gnus-set-mode-line 'summary))
 748
 749 (if (string-match "September" gnus-version)
 750     (defalias 'grouplens-score-thread 'grouplens-score-thread-sept)
 751   (defalias 'grouplens-score-thread 'grouplens-score-thread-v5))
 752
 753 (defun get-current-id ()
 754   (if gnus-current-headers
 755       (aref gnus-current-headers (nth 1 (assoc "message-id" gnus-header-index)))
 756     (gnus-message 3 "You must select an article before you rate it")))
 757
 758
 759 (defvar gnus-tmp-group)
 760 (defun gnus-user-format-function-I (header)
 761   (let ((gname (if (string-match "September" gnus-version)
 762                    gnus-tmp-group
 763                  group)))
 764     (if (member gname grouplens-newsgroups)
 765         "  (GroupLens Enhanced)"
 766       ""))
 767 )
 768
 769 (defun bbb-grouplens-group-p (group)
 770   "Say whether GROUP is a GroupLens group."
 771   (if (member group grouplens-newsgroups)
 772       " (GroupLens Enhanced)"
 773     ""))
 774
 775 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 776 ;;          TIME SPENT READING
 777 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 778
 779 (defun grouplens-start-timer ()
 780   (setq starting-time (current-time))
 781 )
 782
 783 (defun grouplens-elapsed-time ()
 784   (let ((et (time-float (current-time))))
 785     (- et (time-float starting-time)))
 786 )
 787
 788 (defun time-float (timeval)
 789   (+ (* (car timeval) 65536)
 790         (cadr timeval)))
 791
 792 (defun grouplens-do-time ()
 793   (let (oldrating)
 794     (if (member gnus-newsgroup-name grouplens-newsgroups)
 795         (progn
 796           (cond ((not (null previous-article))
 797                  (setq  elapsed-time (grouplens-elapsed-time))
 798                  (if (not (setq oldrating (assoc previous-article
 799                                                  grouplens-rating-alist)))
 800                      (setq grouplens-rating-alist (cons (cons previous-article
 801                                                               (cons 0
 802                                                                     elapsed-time))
 803                                                         grouplens-rating-alist))
 804                    (setcdr oldrating (cons (cadr oldrating) elapsed-time)))
 805                  ))
 806           (grouplens-start-timer)
 807           (setq previous-article (get-current-id)))
 808       )                                 ; end if
 809     ))
 810
 811
 812 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 813 ;;          BUG REPORTING
 814 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 815
 816 (defconst gnus-gl-version "$Id: gnus-gl.el,v 1.2 1996/02/25 03:46:03 steve Exp $")
 817 (defconst gnus-gl-maintainer-address "grouplens-bug@cs.umn.edu")
 818 (defun gnus-gl-submit-bug-report ()
 819   "Submit via mail a bug report on gnus-gl"
 820   (interactive)
 821   (require 'reporter)
 822   (reporter-submit-bug-report
 823    gnus-gl-maintainer-address
 824    (concat "gnus-gl.el " gnus-gl-version)
 825    (list 'grouplens-pseudonym
 826          'grouplens-bbb-host
 827          'grouplens-bbb-port
 828          'grouplens-newsgroups
 829          'grouplens-bbb-token
 830          'grouplens-bbb-process
 831          'grouplens-current-group
 832          'grouplens-previous-article
 833          'grouplens-mid-list
 834          'bbb-alist)
 835    nil
 836    'gnus-gl-get-trace))
 837
 838 (defun gnus-gl-get-trace ()
 839 (insert-buffer (concat "trace of BBBD session to " grouplens-bbb-host)))
 840
 841 ;;;
 842 ;;; Additions to make gnus-grouplens-mode  Warning Warning!!
 843 ;;;      This version of the gnus-grouplens-mode does
 844 ;;;      not work with gnus-5.x.  The "old" way of
 845 ;;;      setting up GroupLens still works however.
 846 ;;;
 847
 848 (defvar gnus-grouplens-mode nil
 849   "Minor mode for providing a GroupLens interface in Gnus summary buffers.")
 850
 851 (defvar gnus-grouplens-mode-map nil)
 852
 853 (unless gnus-grouplens-mode-map
 854   (setq gnus-grouplens-mode-map (make-keymap))
 855   (gnus-define-keys
 856    gnus-grouplens-mode-map
 857    "n" grouplens-next-unread-article
 858    "r" bbb-summary-rate-article
 859    "k" grouplens-score-thread
 860    "," grouplens-best-unread-article))
 861
 862 (defun gnus-grouplens-make-menu-bar ()
 863   (unless (boundp 'gnus-grouplens-menu)
 864     (easy-menu-define
 865      gnus-grouplens-menu gnus-grouplens-mode-map ""
 866      '("GroupLens"
 867        ["Login" bbb-login t]
 868        ["Rate" bbb-summary-rate-article t]
 869        ["Next article" grouplens-next-unread-article t]
 870        ["Best article" grouplens-best-unread-article t]
 871        ["Raise thread" grouplens-score-thread-sept t]
 872        ["Report bugs" gnus-gl-submit-bug-report t]))))
 873
 874 (defun gnus-grouplens-mode (&optional arg)
 875   "Minor mode for providing a GroupLens interface in Gnus summary buffers."
 876   (interactive "P")
 877   (when (and (eq major-mode 'gnus-summary-mode)
 878              (member gnus-newsgroup-name grouplens-newsgroups))
 879     (make-local-variable 'gnus-grouplens-mode)
 880     (setq gnus-grouplens-mode
 881           (if (null arg) (not gnus-grouplens-mode)
 882             (> (prefix-numeric-value arg) 0)))
 883     (when gnus-grouplens-mode
 884       (make-local-hook 'gnus-select-article-hook)
 885       (add-hook 'gnus-select-article-hook 'grouplens-do-time)
 886       (make-local-hook 'bbb-put-ratings)
 887       (add-hook 'gnus-exit-group-hook 'bbb-put-ratings)
 888       (setq gnus-score-find-score-files-function 'bbb-build-mid-scores-alist)
 889       (make-local-variable 'gnus-summary-line-format)
 890       (setq gnus-summary-line-format gnus-summary-grouplens-line-format)
 891       (make-local-variable 'gnus-summary-line-format-spec)
 892
 893       ;; Set up the menu.
 894       (when (and menu-bar-mode
 895                  (gnus-visual-p 'grouplens-menu 'menu))
 896         (gnus-grouplens-make-menu-bar)
 897         (easy-menu-add 'gnus-grouplens-menu))
 898       (unless (assq 'gnus-grouplens-mode minor-mode-alist)
 899         (push '(gnus-grouplens-mode " GroupLens") minor-mode-alist))
 900       (unless (assq 'gnus-grouplens-mode minor-mode-map-alist)
 901         (push (cons 'gnus-grouplens-mode gnus-grouplens-mode-map)
 902               minor-mode-map-alist))
 903       (run-hooks 'gnus-grouplens-mode-hook))))
 904
 905 (provide 'gnus-gl)
 906
 907
 908