Function: erc-match-message

erc-match-message is a byte-compiled function defined in erc-match.el.gz.

Signature

(erc-match-message)

Documentation

Mark certain keywords in a region.

Use this defun with erc-insert-modify-hook.

Source Code

;; Defined in /usr/src/emacs/lisp/erc/erc-match.el.gz
(defun erc-match-message ()
  "Mark certain keywords in a region.
Use this defun with `erc-insert-modify-hook'."
  ;; This needs some refactoring.
  (goto-char (point-min))
  (let* ((to-match-nick-dep '("pal" "fool" "dangerous-host"))
	 (to-match-nick-indep '("keyword" "current-nick"))
	 (vector (erc-get-parsed-vector (point-min)))
	 (nickuserhost (erc-get-parsed-vector-nick vector))
	 (nickname (and nickuserhost
			(nth 0 (erc-parse-user nickuserhost))))
	 ;; (old-pt (point))
	 (nick-beg (and nickname
			(re-search-forward (regexp-quote nickname)
					   (point-max) t)
			(match-beginning 0)))
	 (nick-end (when nick-beg
		     (match-end 0)))
         (message-beg (if (and nick-end
                               (<= (+ 2 nick-end) (point-max)))
                          ;; Message starts 2 characters after the
                          ;; nick except for CTCP ACTION messages.
                          ;; Nick surrounded by angle brackets only in
                          ;; normal messages.
                          (+ nick-end
                             (if (eq ?> (char-after nick-end))
                                 2
                               1))
                        (point-min)))
         (message (buffer-substring message-beg (point-max))))
    (when (and vector
	       (not (and erc-match-exclude-server-buffer
			 (erc-server-buffer-p))))
      (mapc
       (lambda (match-type)
	 (goto-char (point-min))
	 (let* ((match-prefix (concat "erc-" match-type))
		(match-pred (intern (concat "erc-match-" match-type "-p")))
		(match-htype (symbol-value (intern (concat match-prefix
                                                           "-highlight-type"))))
		(match-regex (if (string= match-type "current-nick")
				 (regexp-quote (erc-current-nick))
			       (symbol-value
                                (intern (concat match-prefix "s")))))
		(match-face (intern (concat match-prefix "-face"))))
	   (when (funcall match-pred nickuserhost message)
	     (cond
	      ;; Highlight the nick of the message
	      ((and (eq match-htype 'nick)
		    nick-end)
	       (erc-put-text-property
		nick-beg nick-end
		'font-lock-face match-face (current-buffer)))
	      ;; Highlight the nick of the message, or the current
	      ;; nick if there's no nick in the message (e.g. /NAMES
	      ;; output)
	      ((and (string= match-type "current-nick")
		    (eq match-htype 'nick-or-keyword))
	       (if nick-end
		   (erc-put-text-property
		    nick-beg nick-end
		    'font-lock-face match-face (current-buffer))
		 (goto-char (+ 2 (or nick-end
				     (point-min))))
		 (while (re-search-forward match-regex nil t)
		   (erc-put-text-property (match-beginning 0) (match-end 0)
					  'font-lock-face match-face))))
              ;; Highlight the whole message (not including the nick)
              ((eq match-htype 'message)
               (erc-put-text-property
                message-beg (point-max)
                'font-lock-face match-face (current-buffer)))
	      ;; Highlight the whole message (including the nick)
	      ((eq match-htype 'all)
	       (erc-put-text-property
		(point-min) (point-max)
		'font-lock-face match-face (current-buffer)))
	      ;; Highlight all occurrences of the word to be
	      ;; highlighted.
	      ((and (string= match-type "keyword")
		    (eq match-htype 'keyword))
	       (mapc (lambda (elt)
		       (let ((regex elt)
			     (face match-face))
			 (when (consp regex)
			   (setq regex (car elt)
				 face (cdr elt)))
			 (goto-char (+ 2 (or nick-end
					     (point-min))))
			 (while (re-search-forward regex nil t)
			   (erc-put-text-property
			    (match-beginning 0) (match-end 0)
			    'font-lock-face face))))
		     match-regex))
	      ;; Highlight all occurrences of our nick.
	      ((and (string= match-type "current-nick")
		    (eq match-htype 'keyword))
	       (goto-char (+ 2 (or nick-end
				   (point-min))))
	       (while (re-search-forward match-regex nil t)
		 (erc-put-text-property (match-beginning 0) (match-end 0)
					'font-lock-face match-face)))
	      ;; Else twiddle your thumbs.
	      (t nil))
	     (run-hook-with-args
	      'erc-text-matched-hook
	      (intern match-type)
	      (or nickuserhost
		  (concat "Server:" (erc-get-parsed-vector-type vector)))
	      message))))
       (if nickuserhost
	   (append to-match-nick-dep to-match-nick-indep)
	 to-match-nick-indep)))))