/[emacs]/emacs/lisp/net/rcirc.el
ViewVC logotype

Diff of /emacs/lisp/net/rcirc.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6 by eliz, Fri Nov 4 15:05:11 2005 UTC revision 1.7 by eliz, Sat Nov 19 13:11:36 2005 UTC
# Line 257  respectively." Line 257  respectively."
257  (defvar rcirc-process-output nil)  (defvar rcirc-process-output nil)
258  (defvar rcirc-topic nil)  (defvar rcirc-topic nil)
259  (defvar rcirc-keepalive-timer nil)  (defvar rcirc-keepalive-timer nil)
260  (make-variable-buffer-local 'rcirc-topic)  (defvar rcirc-last-server-message-time nil)
261  (defun rcirc-connect (server port nick user-name full-name startup-channels)  (defun rcirc-connect (server port nick user-name full-name startup-channels)
262    "Return a connection to SERVER on PORT.    "Return a connection to SERVER on PORT.
263    
# Line 290  STARTUP-CHANNELS will automatically be j Line 290  STARTUP-CHANNELS will automatically be j
290        (setq rcirc-process-output nil)        (setq rcirc-process-output nil)
291        (make-local-variable 'rcirc-startup-channels)        (make-local-variable 'rcirc-startup-channels)
292        (setq rcirc-startup-channels startup-channels)        (setq rcirc-startup-channels startup-channels)
293          (make-local-variable 'rcirc-last-server-message-time)
294          (setq rcirc-last-server-message-time (current-time))
295    
296        ;; identify        ;; identify
297        (rcirc-send-string process (concat "NICK " nick))        (rcirc-send-string process (concat "NICK " nick))
# Line 313  STARTUP-CHANNELS will automatically be j Line 315  STARTUP-CHANNELS will automatically be j
315       ,@body))       ,@body))
316    
317  (defun rcirc-keepalive ()  (defun rcirc-keepalive ()
318    "Send keep alive pings to active rcirc processes."    "Send keep alive pings to active rcirc processes.
319    Kill processes that have not received a server message since the
320    last ping."
321    (if (rcirc-process-list)    (if (rcirc-process-list)
322        (mapc (lambda (process)        (mapc (lambda (process)
323                (with-rcirc-process-buffer process                (with-rcirc-process-buffer process
324                  (rcirc-send-string process (concat "PING " rcirc-server))))                  (if (> (cadr (time-since rcirc-last-server-message-time))
325                           rcirc-keepalive-seconds)
326                        (kill-process process)
327                      (rcirc-send-string process (concat "PING " rcirc-server)))))
328              (rcirc-process-list))              (rcirc-process-list))
329      (cancel-timer rcirc-keepalive-timer)      (cancel-timer rcirc-keepalive-timer)
330      (setq rcirc-keepalive-timer nil)))      (setq rcirc-keepalive-timer nil)))
# Line 380  Function is called with PROCESS COMMAND Line 387  Function is called with PROCESS COMMAND
387    "Called when PROCESS receives OUTPUT."    "Called when PROCESS receives OUTPUT."
388    (rcirc-debug process output)    (rcirc-debug process output)
389    (with-rcirc-process-buffer process    (with-rcirc-process-buffer process
390        (setq rcirc-last-server-message-time (current-time))
391      (setq rcirc-process-output (concat rcirc-process-output output))      (setq rcirc-process-output (concat rcirc-process-output output))
392      (when (= (aref rcirc-process-output      (when (= (aref rcirc-process-output
393                     (1- (length rcirc-process-output))) ?\n)                     (1- (length rcirc-process-output))) ?\n)
# Line 582  If buffer is nil, return the target of t Line 590  If buffer is nil, return the target of t
590    (setq rcirc-process process)    (setq rcirc-process process)
591    (make-local-variable 'rcirc-target)    (make-local-variable 'rcirc-target)
592    (setq rcirc-target target)    (setq rcirc-target target)
593      (make-local-variable 'rcirc-topic)
594      (setq rcirc-topic nil)
595    
596    (make-local-variable 'rcirc-short-buffer-name)    (make-local-variable 'rcirc-short-buffer-name)
597    (setq rcirc-short-buffer-name nil)    (setq rcirc-short-buffer-name nil)
# Line 850  Create the buffer if it doesn't exist." Line 860  Create the buffer if it doesn't exist."
860        (process-buffer process))))        (process-buffer process))))
861    
862  (defun rcirc-format-response-string (process sender response target text)  (defun rcirc-format-response-string (process sender response target text)
863    (concat (when rcirc-time-format    (concat (rcirc-facify (format-time-string rcirc-time-format (current-time))
864              (format-time-string rcirc-time-format (current-time)))                          'rcirc-timestamp)
865            (cond ((or (string= response "PRIVMSG")            (cond ((or (string= response "PRIVMSG")
866                       (string= response "NOTICE")                       (string= response "NOTICE")
867                       (string= response "ACTION"))                       (string= response "ACTION"))
# Line 880  Create the buffer if it doesn't exist." Line 890  Create the buffer if it doesn't exist."
890                  (t                  (t
891                   (rcirc-mangle-text                   (rcirc-mangle-text
892                    process                    process
893                    (rcirc-facify                    (concat (rcirc-facify "*** " 'rcirc-server-prefix)
894                     (concat "*** "                            (rcirc-facify
895                             (when (not (string= sender (rcirc-server process)))                             (concat
896                               (concat (rcirc-user-nick sender) " "))                              (when (not (string= sender (rcirc-server process)))
897                             (when (zerop (string-to-number response))                                (concat (rcirc-user-nick sender) " "))
898                               (concat response " "))                              (when (zerop (string-to-number response))
899                             text)                                (concat response " "))
900                     'rcirc-server))))))                              text)
901                               'rcirc-server)))))))
902    
903  (defvar rcirc-activity-type nil)  (defvar rcirc-activity-type nil)
904  (make-variable-buffer-local 'rcirc-activity-type)  (make-variable-buffer-local 'rcirc-activity-type)
# Line 1446  With a prefix arg, prompt for new topic. Line 1457  With a prefix arg, prompt for new topic.
1457    "Return a copy of STRING with FACE property added."    "Return a copy of STRING with FACE property added."
1458    (propertize (or string "") 'face face 'rear-nonsticky t))    (propertize (or string "") 'face face 'rear-nonsticky t))
1459    
 ;; shy grouping must be used within this regexp  
1460  (defvar rcirc-url-regexp  (defvar rcirc-url-regexp
1461    "\\b\\(?:\\(?:www\\.\\|\\(?:s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\    (rx word-boundary
1462  \\|wais\\|mailto\\):\\)\\(?://[-a-zA-Z0-9_.]+:[0-9]*\\)?\\(?:[-a-zA-Z0-9_=!?#$\        (or "www."
1463  @~`%&*+|\\/:;.,]\\|\\w\\)+\\(?:[-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)\\)"            (and (or "http" "https" "ftp" "file" "gopher" "news" "telnet" "wais"
1464                       "mailto")
1465                   "://"
1466                   (1+ (char "a-zA-Z0-9_."))
1467                   (optional ":" (1+ (char "0-9")))))
1468          (1+ (char "-a-zA-Z0-9_=!?#$\@~`%&*+|\\/:;.,"))
1469          (char "-a-zA-Z0-9_=!?#$\@~`%&*+|\\/:;"))
1470    "Regexp matching URL's.  Set to nil to disable URL features in rcirc.")    "Regexp matching URL's.  Set to nil to disable URL features in rcirc.")
1471    
1472  (defun rcirc-browse-url (&optional arg)  (defun rcirc-browse-url (&optional arg)
# Line 1498  FUNCTION takes 3 arguments, MATCH-START, Line 1514  FUNCTION takes 3 arguments, MATCH-START,
1514    "Return TEXT with properties added based on various patterns."    "Return TEXT with properties added based on various patterns."
1515    ;; ^B    ;; ^B
1516    (setq text    (setq text
1517          (rcirc-map-regexp (lambda (start end string)          (rcirc-map-regexp
1518                              (add-text-properties           (lambda (start end string)
1519                               start end             (let ((orig-face (get-text-property start 'face string)))
1520                               (list 'face 'bold 'rear-nonsticky t)                 (add-text-properties
1521                               string))                  start end
1522                            "\
.*?\
"
                 (list 'face (if (listp orig-face)
1523                            text))                                  (append orig-face
1524    (while (string-match "\\(.*\\)[\
&]\\(.*\\)" text) ; deal with 
                                         (list 'bold))
1525                                  (list orig-face 'bold))
1526                          'rear-nonsticky t)
1527                    string)))
1528               "\
.*?\
"
1529               text))
1530      ;; TODO: deal with ^_ and ^C colors sequences
1531      (while (string-match "\\(.*\\)[\
&]\\(.*\\)" text)
1532      (setq text (concat (match-string 1 text)      (setq text (concat (match-string 1 text)
1533                         (match-string 2 text))))                         (match-string 2 text))))
1534    ;; my nick    ;; my nick
# Line 1527  FUNCTION takes 3 arguments, MATCH-START, Line 1550  FUNCTION takes 3 arguments, MATCH-START,
1550           (lambda (start end string)           (lambda (start end string)
1551             (let ((orig-face (get-text-property start 'face string)))             (let ((orig-face (get-text-property start 'face string)))
1552               (add-text-properties start end               (add-text-properties start end
1553                                    (list 'face (list orig-face 'bold)                                    (list 'face (if (listp orig-face)
1554                                                      (append orig-face
1555                                                              (list 'bold))
1556                                                    (list orig-face 'bold))
1557                                          'rear-nonsticky t                                          'rear-nonsticky t
1558                                          'mouse-face 'highlight                                          'mouse-face 'highlight
1559                                          'keymap rcirc-browse-url-map)                                          'keymap rcirc-browse-url-map)
# Line 1836  Passwords are read from `rcirc-authinfo- Line 1862  Passwords are read from `rcirc-authinfo-
1862    :group 'rcirc    :group 'rcirc
1863    :group 'faces)    :group 'faces)
1864    
1865  (defface rcirc-my-nick  (defface rcirc-my-nick                  ; font-lock-function-name-face
1866    '((((type tty) (class color)) (:foreground "blue" :weight bold))    '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
1867      (((class color) (background light)) (:foreground "Blue"))      (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
1868      (((class color) (background dark)) (:foreground "LightSkyBlue"))      (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
1869      (t (:inverse-video t :bold t)))      (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
1870        (((class color) (min-colors 8)) (:foreground "blue" :weight bold))
1871        (t (:inverse-video t :weight bold)))
1872    "The face used to highlight my messages."    "The face used to highlight my messages."
1873    :group 'rcirc-faces)    :group 'rcirc-faces)
1874    
1875  (defface rcirc-other-nick  (defface rcirc-other-nick            ; font-lock-variable-name-face
1876    '((((type tty) (class color)) (:foreground "yellow" :weight light))    '((((class grayscale) (background light))
1877      (((class grayscale) (background light))       (:foreground "Gray90" :weight bold :slant italic))
      (:foreground "Gray90" :bold t :italic t))  
1878      (((class grayscale) (background dark))      (((class grayscale) (background dark))
1879       (:foreground "DimGray" :bold t :italic t))       (:foreground "DimGray" :weight bold :slant italic))
1880      (((class color) (background light)) (:foreground "DarkGoldenrod"))      (((class color) (min-colors 88) (background light)) (:foreground "DarkGoldenrod"))
1881      (((class color) (background dark)) (:foreground "LightGoldenrod"))      (((class color) (min-colors 88) (background dark)) (:foreground "LightGoldenrod"))
1882      (t (:bold t :italic t)))      (((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
1883        (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
1884        (((class color) (min-colors 8)) (:foreground "yellow" :weight light))
1885        (t (:weight bold :slant italic)))
1886    "The face used to highlight other messages."    "The face used to highlight other messages."
1887    :group 'rcirc-faces)    :group 'rcirc-faces)
1888    
1889  (defface rcirc-server  (defface rcirc-server                   ; font-lock-comment-face
1890    '((((type tty pc) (class color) (background light)) (:foreground "red"))    '((((class grayscale) (background light))
1891      (((type tty pc) (class color) (background dark)) (:foreground "red1"))       (:foreground "DimGray" :weight bold :slant italic))
     (((class grayscale) (background light))  
      (:foreground "DimGray" :bold t :italic t))  
1892      (((class grayscale) (background dark))      (((class grayscale) (background dark))
1893       (:foreground "LightGray" :bold t :italic t))       (:foreground "LightGray" :weight bold :slant italic))
1894      (((class color) (background light)) (:foreground "gray40"))      (((class color) (min-colors 88) (background light))
1895      (((class color) (background dark)) (:foreground "chocolate1"))       (:foreground "Firebrick"))
1896      (t (:bold t :italic t)))      (((class color) (min-colors 88) (background dark))
1897         (:foreground "chocolate1"))
1898        (((class color) (min-colors 16) (background light))
1899         (:foreground "red"))
1900        (((class color) (min-colors 16) (background dark))
1901         (:foreground "red1"))
1902        (((class color) (min-colors 8) (background light))
1903         )
1904        (((class color) (min-colors 8) (background dark))
1905         )
1906        (t (:weight bold :slant italic)))
1907    "The face used to highlight server messages."    "The face used to highlight server messages."
1908    :group 'rcirc-faces)    :group 'rcirc-faces)
1909    
1910  (defface rcirc-nick-in-message  (defface rcirc-server-prefix     ; font-lock-comment-delimiter-face
1911    '((((type tty) (class color)) (:foreground "cyan" :weight bold))    '((default :inherit font-lock-comment-face)
1912      (((class grayscale) (background light)) (:foreground "LightGray" :bold t))      (((class grayscale)))
1913      (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))      (((class color) (min-colors 16)))
1914      (((class color) (background light)) (:foreground "Purple"))      (((class color) (min-colors 8) (background light))
1915      (((class color) (background dark)) (:foreground "Cyan"))       :foreground "red")
1916      (t (:bold t)))      (((class color) (min-colors 8) (background dark))
1917         :foreground "red1"))
1918      "The face used to highlight server prefixes."
1919      :group 'rcirc-faces)
1920    
1921    (defface rcirc-timestamp
1922      '((t (:inherit default)))
1923      "The face used to highlight timestamps."
1924      :group 'rcirc-faces)
1925    
1926    (defface rcirc-nick-in-message          ; font-lock-keyword-face
1927      '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold))
1928        (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold))
1929        (((class color) (min-colors 88) (background light)) (:foreground "Purple"))
1930        (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1"))
1931        (((class color) (min-colors 16) (background light)) (:foreground "Purple"))
1932        (((class color) (min-colors 16) (background dark)) (:foreground "Cyan"))
1933        (((class color) (min-colors 8)) (:foreground "cyan" :weight bold))
1934        (t (:weight bold)))
1935    "The face used to highlight instances of nick within messages."    "The face used to highlight instances of nick within messages."
1936    :group 'rcirc-faces)    :group 'rcirc-faces)
1937    
1938  (defface rcirc-prompt  (defface rcirc-prompt                   ; comint-highlight-prompt
1939    '((((background dark)) (:foreground "cyan"))    '((((min-colors 88) (background dark)) (:foreground "cyan1"))
1940        (((background dark)) (:foreground "cyan"))
1941      (t (:foreground "dark blue")))      (t (:foreground "dark blue")))
1942    "The face to use to highlight prompts."    "The face to use to highlight prompts."
1943    :group 'rcirc-faces)    :group 'rcirc-faces)

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26