[Date Prev][Date Next][Thread Prev][][Date Index][Thread Index]

[BUGFIX] w3m-session updating faces [PATCH]



In [emacs-w3m:12968], I noted that text property faces weren't being
updated for all navigation cases. The attached code corrects that.
Because of the number of patches submitted in such a short span dealing
with the same functions, this time instead of submitting another unified
diff, I'm attaching a complete snippet of the affected block of code -
the diff file is just a changelog entry.


-- 
hkp://keys.gnupg.net
CA45 09B5 5351 7C11 A9D1  7286 0036 9E45 1595 8BC0
(defun w3m-session-select-mode (&optional sessions)
  "Major mode for selecting emacs-w3m session.

\\<w3m-session-select-mode-map>
\\[w3m-session-select-select]	Select the session.
\\[w3m-session-select-open-session-group]	Open the session group.
\\[w3m-session-select-delete]	Delete the session.
\\[w3m-session-select-rename]	Rename the session.
\\[w3m-session-select-save]	Save the session.
\\[w3m-session-select-next]	Move the point to the next session.
\\[w3m-session-select-previous]	Move the point to the previous session.
\\[w3m-session-select-quit]	Exit selecting session.
"
  (w3m-session-ignore-errors
   (let ((sessions (or sessions
		       (w3m-load-list w3m-session-file))))
     (buffer-disable-undo)
     (setq mode-name "w3m session"
	   truncate-lines t
	   buffer-read-only nil
	   major-mode 'w3m-session-select-mode
	   w3m-session-select-sessions sessions
	   buffer-read-only t)
     (setq w3m-session-group-open nil)
     (use-local-map w3m-session-select-mode-map)
     (w3m-session-select-list-all-sessions)
     (add-hook 'pre-command-hook 'w3m--session-update-faces t t)
     (add-hook 'post-command-hook 'w3m--session-update-faces t t))))

(defun w3m--session-update-faces ()
  "A hook function for `w3m-session-select' buffers.
Meant for use  with  `pre-command-hook' and `post-command-hook'."
  (let ((beg (line-beginning-position))
	(inhibit-read-only t))
   (put-text-property beg (next-single-property-change beg 'w3m-session-number)
     'face
     (if (equal (get-text-property beg 'face) 'w3m-session-select)
       'w3m-session-selected
      'w3m-session-select))))

(defun w3m-session-select-list-all-sessions ()
  "List all saved sessions."
  (let ((sessions w3m-session-select-sessions)
	(num 0)
	(max 0)
	(inhibit-read-only t)
	title titles time times wid pos)
    (if (not sessions)
	(progn
	  (message "No saved session")
	  (w3m-session-select-quit))
      (mapc (lambda (x)
	      (setq title (format "%s[%d]" (nth 0 x) (length (nth 2 x))))
	      (setq wid (string-width title))
	      (when (> wid max)
		(setq max wid))
	      (setq titles (cons title titles))
	      (setq times (cons (format-time-string w3m-session-time-format
						    (nth 1 x))
				times)))
	    sessions)
      (setq titles (nreverse titles))
      (setq times (nreverse times))
      (setq max (+ max 2))
      (erase-buffer)
      (while (and (setq title (car titles))
		  (setq time (car times)))
	(setq titles (cdr titles))
	(setq times (cdr times))
	(setq pos (point))
	(insert title)
	(add-text-properties pos (point)
			     `(face w3m-session-select
				    w3m-session-number ,num))
	(setq num (1+ num))
	(insert (make-string (- max (string-width title)) ?\ ))
	(insert time "\n"))
      (delete-char -1)
      (goto-char (point-min))
      (set-buffer-modified-p nil)
      (setq buffer-read-only t))))

(defun w3m-session-select-list-session-group (arg)
  "List all buffers (i.e., tabs) within a session.

The list can be acted upon similarly to a session list, i.e.,
entries can be individually deleted, renamed, or opened as a new
buffer in the current session."
  (let ((session (nth 2 (nth arg w3m-session-select-sessions)))
	(num 0)
	(max 0)
	(inhibit-read-only t)
	title url wid
	titles urls pos)
    (when session
      (mapc (lambda (x)
	      (setq title
		    (format "%s" (or (nth 3 x) w3m-session-unknown-title)))
	      (setq wid (string-width title))
	      (when (> wid max)
		(setq max wid))
	      (setq titles (cons title titles))
	      (setq urls (cons (nth 0 x)
			       urls)))
	    session)
      (setq titles (nreverse titles))
      (setq urls (nreverse urls))
      (setq max (+ max 2))
      (erase-buffer)
      (insert "Select session:\n\n")
      (setq pos (point))
      (insert "Open all sessions")
      (add-text-properties pos (point)
			   `(face w3m-session-selected
				  w3m-session-number ,arg))
      (insert "\n")
      (while (and (setq title (car titles))
		  (setq url (car urls)))
	(setq titles (cdr titles))
	(setq urls (cdr urls))
	(setq pos (point))
	(insert title)
	(add-text-properties pos (point)
			     `(face w3m-session-select
				    w3m-session-number ,(cons arg num)))
	(setq num (1+ num))
	(insert (make-string (- max (string-width title)) ?\ ))
	(insert url "\n"))
      (goto-char (point-min))
      (goto-char (next-single-property-change
		  (point) 'w3m-session-number)))
    (set-buffer-modified-p nil)
    (setq buffer-read-only t)))

(defun w3m-session-select-next (&optional arg)
  "Move the point to the next session."
  (interactive "p")
  (unless arg (setq arg 1))
  (let ((target (1+ (mod (1- (+ arg (line-number-at-pos (point))))
                     (line-number-at-pos (point-max))))))
    (goto-char (point-min))
    (forward-line (1- target))
    (set-buffer-modified-p nil)))

(defun w3m-session-select-previous (&optional arg)
  "the point to the previous session."
  (interactive "p")
  (w3m-session-select-next (- arg)))
Index: ChangeLog
===================================================================
RCS file: /storage/cvsroot/emacs-w3m/ChangeLog,v
retrieving revision 1.3665
diff -b -u -w -r1.3665 ChangeLog
--- ChangeLog	2 May 2018 05:38:10 -0000	1.3665
+++ ChangeLog	9 May 2018 15:33:28 -0000
@@ -1,3 +1,12 @@
+2018-05-09  Boruch Baum  <boruch_baum@xxxxxxx>
+
+	* w3m-session.el (w3m--session-update-faces): New function for
+	`pre-command-hook' and `post-command-hook' in w3m-session buffers.
+	(w3m-session-select-mode): Apply new function.
+	(w3m-session-select-list-all-sessions, w3m-session-select-next): Don't
+	set the "selected" face, because it is now done by the new hook
+	function.
+
 2018-05-02  Katsumi Yamaoka  <yamaoka@xxxxxxx>
 
 	* w3m-image.el (w3m-favicon-usable-p): Relax the criterion.