1;;; w3m-hist.el --- the history management system for emacs-w3m 2 3;; Copyright (C) 2001-2012, 2019-2021 TSUCHIYA Masatoshi <tsuchiya@namazu.org> 4 5;; Author: Katsumi Yamaoka <yamaoka@jpl.org> 6;; Keywords: w3m, WWW, hypermedia 7 8;; This file is a part of emacs-w3m. 9 10;; This program is free software; you can redistribute it and/or modify 11;; it under the terms of the GNU General Public License as published by 12;; the Free Software Foundation; either version 2, or (at your option) 13;; any later version. 14 15;; This program is distributed in the hope that it will be useful, 16;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18;; GNU General Public License for more details. 19 20;; You should have received a copy of the GNU General Public License 21;; along with this program; see the file COPYING. If not, write to 22;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 23;; Boston, MA 02110-1301, USA. 24 25;;; Commentary: 26 27;; Emacs-w3m keeps history in the buffer-local variables `w3m-history' 28;; and `w3m-history-flat'. Each variable contains a list of all the 29;; links you have visited. The behavior tracing history backward or 30;; forward is controlled by the `w3m-history-reuse-history-elements' 31;; variable. See the documentations for those variables for details. 32 33;;; Code: 34 35(require 'cl-lib) ;; cl-decf, cl-incf 36(require 'w3m-util) 37 38(defcustom w3m-history-reuse-history-elements nil 39 "Non-nil means reuse the history element when re-visiting the page. 40Otherwise, a new history element will be created even if there are 41elements for the same url in the history. 42 43Emacs-w3m used to operate as the case in which it is non-nil, however 44it sometimes brought about users' dissatisfaction. For example, if a 45user visited the pages A -> B -> C -> B in order, performing BACK on 46the second B would let a user visit A. The reason why a user was 47taken to A rather than C is that the `w3m-history' variable only had 48the list `(A B C)' as a history and B was the current position at that 49time. 50 51The default value for this variable is nil which allows the 52`w3m-history' variable to have the list `(A B C B)'. Where contents 53of two B's are the identical Lisp objects. So, too much wasting the 54Lisp resources will be avoided. 55 56See the documentation for the variables `w3m-history' and 57`w3m-history-flat' for more information." 58 :group 'w3m 59 :type '(boolean :format "%{%t%}: %[%v%]" :on "On" :off "Off")) 60 61(defcustom w3m-history-minimize-in-new-session nil 62 "Non-nil means minimize copied history so that there's only current page. 63This variable is effective when creating of the new session by copying 64(i.e., `w3m-copy-buffer')." 65 :group 'w3m 66 :type '(boolean :format "%{%t%}: %[%v%]" :on "On" :off "Off")) 67 68(defvar w3m-history nil 69 "A tree-structured complex list of all the links which you have visited. 70This is a buffer-local variable. For example, it will grow as follows: 71 72[Branch-1.0.0.0]: +--> U1.0.0.0.0 --> U1.0.0.0.1 73 | 74 [Branch-1.0]: +--> U1.0.0 --> U1.0.1 --> U1.0.2 75 | 76 [Trunk]: U0 --> U1 --> U2 --> U3 --> U4 --> U5 --> U6 77 | 78 [Branch-2.0]: +--> U2.0.0 --> U2.0.1 79 | 80 [Branch-2.1]: +--> U2.1.0 --> U2.1.1 --> U2.1.2 81 | 82[Branch-2.1.1.0]: +--> U2.1.1.0.0 83 84In this case, the U1.0.0.0.0 history element represents the first link 85of the first branch which is sprouted from the U1.0.0 history element. 86 87The trunk or each branch is a simple list which will contain some 88history elements. History elements in the trunk or each branch will 89be arranged in increasing order (the newest history element will be 90the last element of the list). Each history element represents a link 91which consists of the following records: 92 93 (URL PROPERTIES BRANCH BRANCH ...) 94 95Where URL is a string of an address of a link. PROPERTIES is a plist 96which is able to contain any kind of data to supplement the URL as 97follows: 98 99 (KEYWORD VALUE KEYWORD VALUE ...) 100 101A note for programmers: PROPERTIES should always be a non-nil value in 102order to make it easy to share the value in every history element in 103every emacs-w3m buffer. 104 105The remaining BRANCHes are branches of the history element. Branches 106will also be arranged in increasing order (the newest one will be the 107rightmost element). Each BRANCH will also be a tree-structured 108complex list. Therefore, the history structure will grow up 109infinitely. 110 111In order to save the Lisp resources, URL strings and PROPERTIES in the 112`w3m-history' variables are shared in every emacs-w3m buffer (it means 113each element in two `w3m-history' variables can be compared by `eq' 114rather than `equal'). If there is necessity to make buffer-local 115properties, in other words, to make properties of which values differ 116in every emacs-w3m buffer, use the `w3m-history-flat' variable instead. 117 118There are special rules on the emacs-w3m history management system. 119As you perhaps foresaw, the operation BACK on U2.0.0 brings you to U2, 120and one more BACK brings you to U1. Well, where do you think we 121should go next when the operation FORWARD is performed on U1? The 122rule is to go to the newest link you have ever visited. So, that 123operation should take you to U1.0.0. 124 125Another rule is that the new U4 link should sprout from U1.0.1 if 126`w3m-history-reuse-history-elements' is nil when you visit the U4 link 127directly from U1.0.1. In contrast, you should be taken to the 128existing U4 link instead of sprouting the new branch from U1.0.1 if 129`w3m-history-reuse-history-elements' is non-nil. 130 131In addition, the first element of `w3m-history' is special. It is a 132list containing pointers which point to three history elements as 133shown below: 134 135 (PREV CURRENT NEXT) 136 137PREV points to the previous history element, CURRENT points to the 138current one and NEXT points to the next one. Each of them is a list 139which contains an odd number of integers. For example, `(0)' does 140point to U0 and `(2 1 0)' does point to U2.1.0. Finally, the value of 141the `w3m-history' variable will be constructed as follows: 142 143(((1) (2) (2 1 0)) 144 (\"http://www.U0.org/\" (:title \"U0\" :foo \"bar\")) 145 (\"http://www.U1.org/\" (:title \"U1\" :foo \"bar\") 146 ((\"http://www.U100.org/\" (:title \"U100\" :foo \"bar\") 147 ((\"http://www.U10000.org/\" (:title \"U10000\" :foo \"bar\")) 148 (\"http://www.U10001.org/\" (:title \"U10001\" :foo \"bar\")))) 149 (\"http://www.U101.org/\" (:title \"U101\" :foo \"bar\")) 150 (\"http://www.U102.org/\" (:title \"U102\" :foo \"bar\")))) 151 (\"http://www.U2.org/\" (:title \"U2\" :foo \"bar\") 152 ((\"http://www.U200.org/\" (:title \"U200\" :foo \"bar\")) 153 (\"http://www.U201.org/\" (:title \"U201\" :foo \"bar\"))) 154 ((\"http://www.U210.org/\" (:title \"U210\" :foo \"bar\")) 155 (\"http://www.U211.org/\" (:title \"U211\" :foo \"bar\") 156 ((\"http://www.U21100.org/\" (:title \"U21100\" :foo \"bar\")))) 157 (\"http://www.U212.org/\" (:title \"U212\" :foo \"bar\")))) 158 (\"http://www.U3.org/\" (:title \"U3\" :foo \"bar\")) 159 (\"http://www.U4.org/\" (:title \"U4\" :foo \"bar\")) 160 (\"http://www.U5.org/\" (:title \"U5\" :foo \"bar\")) 161 (\"http://www.U6.org/\" (:title \"U6\" :foo \"bar\")))") 162 163(defvar w3m-history-flat nil 164 "A flattened alist of all the links which you have visited. 165All history elements except for buffer-local properties are the same 166as ones of `w3m-history'. Each element will contain the following 167records: 168 169 (URL PROPERTIES POSITION [KEYWORD VALUE [KEYWORD VALUE ...]]) 170 171Where URL is a string of an address of a link, PROPERTIES is a plist 172which is able to contain any kind of data to supplement the URL. Each 173PROPERTIES is the Lisp object identical with that corresponding 174element of `w3m-history'. POSITION is a list of integers to designate 175the current position in the history. 176 177The remaining [KEYWORD VALUE [KEYWORD VALUE ...]] is a plist similar 178to PROPERTIES, but it is buffer-local. You can manipulate 179buffer-local properties using the functions `w3m-history-plist-get', 180`w3m-history-plist-put', `w3m-history-add-properties' and 181`w3m-history-remove-properties'. See the documentation for the 182`w3m-history' variable for more information.") 183 184(make-variable-buffer-local 'w3m-history) 185(make-variable-buffer-local 'w3m-history-flat) 186 187;; Inline functions. 188(defsubst w3m-history-assoc (url) 189 "Extract a history element associated with URL from `w3m-history-flat'." 190 (assoc url w3m-history-flat)) 191 192;; Functions for internal use. 193(defun w3m-history-set-current (position) 194 "Modify `w3m-history' so that POSITION might be the current position. 195What is called the current position is the `cadar' of `w3m-history'. 196The previous position and the next position will be computed 197automatically." 198 (setcar w3m-history (w3m-history-regenerate-pointers position))) 199 200(defun w3m-history-element (position &optional flat) 201 "Return a history element located in the POSITION of the history. 202If FLAT is nil, the value will be extracted from `w3m-history' and 203represented with the `(URL PROPERTIES BRANCH BRANCH ...)' form. 204Otherwise, the value will be extracted from `w3m-history-flat' and 205represented with the `(URL PROPERTIES POSITION [KEYWORD VALUE ...])' 206form. FYI, to know the current position, the `(cadar w3m-history)' 207form for example can be used." 208 (when position 209 (if flat 210 (let ((flat w3m-history-flat) 211 element) 212 (while flat 213 (if (equal (caddr (setq element (pop flat))) position) 214 (setq flat nil) 215 (setq element nil))) 216 element) 217 (let ((element (nth (pop position) (cdr w3m-history)))) 218 (while position 219 (setq element (nth (pop position) (cddr element)) 220 element (nth (pop position) element))) 221 element)))) 222 223(defun w3m-history-previous-position (position) 224 "Return a history position of the previous location of POSITION. 225POSITION is a list of integers of the same form as being used in one 226of the elements of the `car' of `w3m-history' (which see)." 227 (let (class number previous) 228 (when position 229 (setq class (1- (length position)) 230 number (nth class position)) 231 (if (zerop number) 232 ;; This POSITION is the beginning of the branch. 233 (unless (zerop class) 234 ;; There's a parent. 235 (setq previous (copy-sequence position)) 236 (setcdr (nthcdr (- class 2) previous) nil)) 237 ;; This POSITION is not the beginning of the branch. 238 (setq previous (copy-sequence position)) 239 (setcar (nthcdr class previous) (1- number)))) 240 previous)) 241 242(defun w3m-history-next-position (position) 243 "Return a history position of the next location of POSITION. 244POSITION is a list of integers of the same form as being used in one 245of the elements of the `car' of `w3m-history' (which see)." 246 (let (next branch element number) 247 (when position 248 (setq next position 249 branch (cdr w3m-history) 250 element (nth (pop next) branch)) 251 (while next 252 (setq branch (nth (pop next) (cddr element)) 253 element (nth (pop next) branch))) 254 (cond ((nth 2 element) 255 ;; There're branches sprouted from the POSITION. 256 (setq next (copy-sequence position)) 257 (setcdr (nthcdr (1- (length next)) next) 258 (list (- (length element) 3) 0))) 259 ((> (length branch) 260 (setq number (1+ (nth (1- (length position)) position)))) 261 ;; This POSITION is not the end of the branch. 262 (setq next (copy-sequence position)) 263 (setcar (nthcdr (1- (length next)) next) number)))) 264 next)) 265 266(defun w3m-history-set-plist (plist property value) 267 "Similar to `plist-put' but PLIST is actually modified. 268If VALUE is nil, the pair of PROPERTY and VALUE is removed from PLIST. 269Exceptionally, if PLIST is made empty because of removing, it will be 270instead set to `(nil nil)'. Return PLIST itself." 271 (unless plist ;; FIXME: when/where/why is it made nil? 272 (setq plist (list nil nil))) 273 (let ((pair (memq property plist))) 274 (if pair 275 (if value 276 (setcar (cdr pair) value) 277 (if (eq (car plist) property) 278 (progn 279 (setcar plist (nth 2 plist)) 280 (setcar (cdr plist) (nth 3 plist)) 281 (setcdr (cdr plist) (nthcdr 4 plist))) 282 (setcdr (nthcdr (- (length plist) (length pair) 1) plist) 283 (nthcdr 2 pair)))) 284 (when value 285 (setcdr (nthcdr (1- (length plist)) plist) (list property value))))) 286 plist) 287 288(defun w3m-history-modify-properties (old new &optional replace) 289 "Merge NEW plist into OLD plist and return a modified plist. 290If REPLACE is non-nil, OLD will be replaced with NEW. OLD plist is 291modified and also the new value is shared in all the history 292elements containing OLD plist. Properties whose values are nil are 293removed from OLD plist, but if OLD plist is made empty because of 294removing, it will be instead set to `(nil nil)'." 295 (prog1 296 old 297 (if replace 298 (progn 299 (setcar old (car new)) 300 (setcdr old (or (cdr new) (list nil)))) 301 (while new 302 (w3m-history-set-plist old (car new) (cadr new)) 303 (setq new (cddr new)))) 304 (unless old ;; FIXME: when/where/why is it made nil? 305 (setq old (list nil nil))) 306 (setq new (copy-sequence old)) 307 (while new 308 (w3m-history-set-plist old (car new) (cadr new)) 309 (setq new (cddr new))))) 310 311(defun w3m-history-seek-element (url &optional newprops replace) 312 "Return a copy of history element corresponding to URL. 313Searching is performed in all emacs-w3m buffers and the first match 314found is returned. If REPLACE is nil, NEPROPS will be merged into 315properties of an element. Otherwise, properties of an element will be 316replaced with NEWPROPS." 317 (let* ((current (current-buffer)) 318 (buffers (cons current (delq current (buffer-list)))) 319 element) 320 (while buffers 321 (set-buffer (pop buffers)) 322 (when (and (eq major-mode 'w3m-mode) 323 (setq element (w3m-history-assoc url))) 324 (setq buffers nil))) 325 (set-buffer current) 326 (prog1 327 (copy-sequence element) 328 (when element 329 (w3m-history-modify-properties (cadr element) newprops replace))))) 330 331;; Generic functions. 332(defun w3m-history-previous-link-available-p () 333 "Return non-nil if the previous history element is available." 334 (caar w3m-history)) 335 336(defun w3m-history-next-link-available-p () 337 "Return non-nil if the next history element is available." 338 (caddar w3m-history)) 339 340(defun w3m-history-backward (&optional count) 341 "Move backward COUNT times in the history structure. 342Return a cons of a new history element and new position pointers of 343the history. The position pointers of `w3m-history' will not change. 344If COUNT is omitted, it defaults to the number one. If COUNT is 345negative, moving forward is performed. Return nil if there is no 346previous element." 347 (when w3m-history 348 (let ((oposition (copy-sequence (car w3m-history))) 349 position last) 350 (cond ((or (unless count 351 (setq count 1)) 352 (> count 0)) 353 (while (and (> count 0) 354 (setq position (caar w3m-history))) 355 (w3m-history-set-current (setq last position)) 356 (cl-decf count))) 357 ((< count 0) 358 (while (and (< count 0) 359 (setq position (caddar w3m-history))) 360 (w3m-history-set-current (setq last position)) 361 (cl-incf count))) 362 (t ;; Don't move. 363 (setq last (cadar w3m-history)))) 364 (prog1 365 (when last 366 (cons (w3m-history-element (cadar w3m-history)) 367 (car w3m-history))) 368 (setcar w3m-history oposition))))) 369 370(defun w3m-history-forward (&optional count) 371 "Move forward COUNT times in the history structure. 372Return a cons of a new history element and new position pointers of 373the history. The position pointers of `w3m-history' will not change. 374If COUNT is omitted, it defaults to the number one. If COUNT is 375negative, moving backward is performed. If there is no room to move 376in the history, move as far as possible." 377 (w3m-history-backward (- (or count 1)))) 378 379(defun w3m-history-regenerate-pointers (position) 380 "Regenerate the position pointers due to only the current POSITION. 381The history position pointers are made with the `(PREV CURRENT NEXT)' 382form which is mentioned in the documentation for `w3m-history'." 383 (list (w3m-history-previous-position position) 384 position 385 (w3m-history-next-position position))) 386 387(defun w3m-history-flat () 388 "Set the value of `w3m-history-flat' due to the value of `w3m-history'. 389See also the documentations for those variables." 390 (setq w3m-history-flat nil) 391 (when w3m-history 392 (let ((history (cdr w3m-history)) 393 (position (list 0)) 394 element branches flag children) 395 (while (setq element (pop history)) 396 (if (stringp (car element)) 397 (progn 398 (push (list (car element) (cadr element) (reverse position)) 399 w3m-history-flat) 400 (if (setq element (cddr element)) 401 (progn 402 (setq history (append element history) 403 position (append (list 0 0) position)) 404 (push (length element) branches)) 405 (setcar position (1+ (car position))) 406 (setq flag t) 407 (while (and flag 408 children 409 (zerop (setcar children (1- (car children))))) 410 (setq children (cdr children)) 411 (if (zerop (setcar branches (1- (car branches)))) 412 (progn 413 (setq branches (cdr branches) 414 position (cddr position)) 415 (setcar position (1+ (car position)))) 416 (setcar position 0) 417 (setcar (cdr position) (1+ (cadr position))) 418 (setq flag nil))))) 419 (setq history (append element history)) 420 (push (length element) children)))) 421 (setq w3m-history-flat (nreverse w3m-history-flat)))) 422 423(defun w3m-history-tree (&optional newpos) 424 "Set the value of `w3m-history' due to the value of `w3m-history-flat'. 425See also the documentations for those variables. NEWPOS specifies the 426current position of the history. It defaults to the beginning 427position of the history." 428 (if w3m-history-flat 429 (let ((flat w3m-history-flat) 430 element positions rest position) 431 (setq w3m-history (list (list nil nil))) 432 (while (setq element (pop flat)) 433 (setq positions (caddr element) 434 rest w3m-history) 435 (while positions 436 (setq position (pop positions)) 437 (unless (> (length rest) position) 438 (setcdr (nthcdr (1- (length rest)) rest) 439 (make-list (- position (length rest) -1) 440 (list nil nil)))) 441 (setq rest (nth position rest)) 442 (when positions 443 (setq position (pop positions)) 444 (unless (> (- (length rest) 2) position) 445 (setcdr (nthcdr (1- (length rest)) rest) 446 (make-list (- position (length rest) -3) 447 (list (list nil nil))))) 448 (setq rest (nth (+ position 2) rest)))) 449 (setcar rest (car element)) 450 (setcar (cdr rest) (cadr element))) 451 (push 'dummy w3m-history) 452 (w3m-history-set-current (or newpos (list 0))) 453 w3m-history) 454 (setq w3m-history nil))) 455 456(defun w3m-history-push (url &optional newprops replace) 457 "Push URL into the history structure. 458A history which corresponds to URL becomes the current one. NEWPROPS 459is a plist which supplements URL. Return a new history position 460pointers. How this function behaves to the history structure (i.e., 461`w3m-history' and `w3m-history-flat') is controlled by the value of 462`w3m-history-reuse-history-elements'. 463 464The case where `w3m-history-reuse-history-elements' is nil: 465 A new history element is always created. If there is another 466 element corresponding to the same URL, its properties are inherited 467 into the new history element. 468 469The case where `w3m-history-reuse-history-elements' is non-nil: 470 If there is an element corresponding to URL in the history, it 471 becomes the current history element. Otherwise, this function 472 behaves like the case where `w3m-history-reuse-history-elements' is 473 nil. 474 475If REPLACE is nil, NEWPROPS is merged into properties of the current 476history element. Otherwise, properties of the current history element 477are replaced with NEWPROPS." 478 (unless (string-match "^about://" url) 479 (let ((element (w3m-history-seek-element url newprops replace)) 480 position class number branch) 481 (if element 482 (setcdr (cdr element) nil) 483 (setq element (list url (w3m-history-modify-properties newprops nil)))) 484 (cond 485 ((null w3m-history) 486 ;; The dawn of the history. 487 (setq position (list nil (list 0) nil) 488 w3m-history (list position element) 489 w3m-history-flat (list (append element (list (list 0))))) 490 position) 491 492 ((and w3m-history-reuse-history-elements 493 (setq position (caddr (w3m-history-assoc url)))) 494 ;; Reuse the existing history element assigned to the current one. 495 ;; The position pointers will be fixed with correct values after 496 ;; visiting a page when moving back, moving forward or jumping from 497 ;; the about://history/ page. 498 (w3m-history-set-current position)) 499 (t 500 ;; Sprout a new history element. 501 (setq position (copy-sequence (cadar w3m-history)) 502 class (1- (length position)) 503 number 0 504 branch (nthcdr (car position) (cdr w3m-history))) 505 (while (> class number) 506 (setq number (1+ number) 507 branch (nth (nth number position) (cddar branch)) 508 number (1+ number) 509 branch (nthcdr (nth number position) branch))) 510 (if (cdr branch) 511 ;; We should sprout a new branch. 512 (progn 513 (setq number (1- (length (car branch)))) 514 (setcdr (nthcdr class position) (list (1- number) 0)) 515 (setcdr (nthcdr number (car branch)) (list (list element)))) 516 ;; The current position is the last of the branch. 517 (setcar (nthcdr class position) 518 (1+ (car (nthcdr class position)))) 519 (setcdr branch (list element))) 520 (setq w3m-history-flat (nconc w3m-history-flat 521 (list (append element (list position))))) 522 (setcar w3m-history (list (cadar w3m-history) position nil))))))) 523 524(defun w3m-history-copy (buffer) 525 "Copy the history structure from BUFFER to the current buffer. 526This function keeps corresponding elements identical Lisp objects 527between buffers while copying the frameworks of `w3m-history' and 528`w3m-history-flat'. Exceptionally, buffer-local properties contained 529in `w3m-history-flat' will not be copied except for the positions. If 530`w3m-history-minimize-in-new-session' is non-nil, the copied history 531structure will be shrunk so that it may contain only the current 532history element." 533 (let ((current (current-buffer)) 534 position flat element props window-start rest) 535 (set-buffer buffer) 536 (when w3m-history 537 (setq position (copy-sequence (cadar w3m-history)) 538 flat w3m-history-flat)) 539 (set-buffer current) 540 (when position 541 (if w3m-history-minimize-in-new-session 542 (progn 543 (setq w3m-history-flat flat 544 element (copy-sequence (w3m-history-element position t))) 545 (setcdr (cdr element) nil) 546 (setq w3m-history (list (list nil (list 0) nil) element) 547 w3m-history-flat (list (append element (list (list 0)))))) 548 ;; Remove buffer-local properties, except for the positions, 549 ;; from the new `w3m-history-flat'. 550 (while flat 551 (setq element (copy-sequence (car flat)) 552 flat (cdr flat) 553 props (cdddr element) 554 window-start (plist-get props :window-start)) 555 (if window-start 556 (setcdr (cddr element) 557 (list :window-start window-start 558 :position (plist-get props :position) 559 :window-hscroll (plist-get props :window-hscroll))) 560 (setcdr (cddr element) nil)) 561 (push element rest)) 562 (setq w3m-history-flat (nreverse rest)) 563 (w3m-history-tree position))))) 564 565(defun w3m-history-plist-get (keyword &optional not-buffer-local) 566 "Extract a value from the properties of the current history element. 567KEYWORD is usually a symbol. This function returns the value 568corresponding to KEYWORD, but it returns nil if the properties don't 569contain KEYWORD. If NOT-BUFFER-LOCAL is nil, this function searches a 570value in buffer-local properties, otherwise looks over the global 571properties instead." 572 (let ((element (w3m-history-element (cadar w3m-history) t))) 573 (plist-get (if not-buffer-local 574 (cadr element) 575 (cdddr element)) 576 keyword))) 577 578(defun w3m-history-add-properties (newprops &optional not-buffer-local) 579 "Add NEWPROPS to the properties of the current history element. 580NEWPROPS should be a plist, which is merged into the properties. 581Return new properties. If NOT-BUFFER-LOCAL is nil, NEWPROPS will be 582added to the buffer-local properties. Otherwise, NEWPROPS will be 583added to the global properties instead." 584 (if not-buffer-local 585 (cadr (w3m-history-seek-element 586 (car (w3m-history-element (cadar w3m-history))) 587 newprops)) 588 (let ((element (w3m-history-element (cadar w3m-history) t)) 589 properties) 590 (when element 591 (setq properties (cdddr element) 592 properties (if properties 593 (w3m-history-modify-properties properties 594 newprops) 595 ;; Use `w3m-history-modify-properties' to remove 596 ;; keyword-value pairs whose value is nil. 597 (w3m-history-modify-properties newprops nil))) 598 (unless (car properties) ;; check whether it is `(nil nil)'. 599 (setq properties nil)) 600 (setcdr (cddr element) properties))))) 601 602(defun w3m-history-plist-put (keyword value &optional not-buffer-local) 603 "Put KEYWORD and VALUE into the current history element. 604Return new properties. If NOT-BUFFER-LOCAL is nil, KEYWORD and VALUE 605will be put into the buffer-local properties. Otherwise, KEYWORD and 606VALUE will be put into the global properties instead." 607 (w3m-history-add-properties (list keyword value) not-buffer-local)) 608 609(defun w3m-history-remove-properties (properties &optional not-buffer-local) 610 "Remove PROPERTIES from the current history element. 611PROPERTIES should be one or more keyword-value pairs (i.e., plist) but 612values are ignored (treated as nil). Return new properties. If 613NOT-BUFFER-LOCAL is nil, the buffer-local properties will be modified. 614Otherwise, the global properties will be modified instead." 615 (let (rest) 616 (while properties 617 (setq rest (cons nil (cons (car properties) rest)) 618 properties (cddr properties))) 619 (w3m-history-add-properties (nreverse rest) not-buffer-local))) 620 621(defun w3m-history-store-position () 622 "Store the current cursor position into the current history element. 623Data consist of the position where the window starts and the cursor 624position. Naturally, those should be treated as buffer-local." 625 (interactive) 626 (when (cadar w3m-history) 627 ;; Emacs lies about the column number in the results of 628 ;; the functions `current-column', `window-hscroll', etc. if there 629 ;; are images; it is likely larger than the position of the cursor 630 ;; actually visible, and restoring it causes h-scrolling too much. 631 ;; So, we store the position of an image if the cursor follows. 632 (let ((column (current-column)) 633 (hscroll (window-hscroll)) 634 pos) 635 (when (cond ((bobp) nil) 636 ((get-text-property (point) 'w3m-image) nil) 637 ((get-text-property (1-(point)) 'w3m-image) 638 (goto-char (1- (point)))) 639 ((setq pos (previous-single-property-change 640 (point) 'w3m-image nil (point-at-bol))) 641 (unless (= pos (point-at-bol)) 642 (goto-char (1- pos))))) 643 (setq pos (current-column)) 644 (move-to-column column) 645 (setq hscroll (max (- hscroll (- column pos)) 0) 646 column pos)) 647 (w3m-history-add-properties 648 (list :window-start (window-start) 649 :position (cons (count-lines (point-min) (point-at-bol)) column) 650 :window-hscroll hscroll))) 651 (when (w3m-interactive-p) 652 (message "The current cursor position saved")))) 653 654(defun w3m-history-restore-position () 655 "Restore the saved cursor position in the page. 656Even if the page has been shrunk (by reloading, for example), somehow 657it works although it may not be perfect." 658 (interactive) 659 (when (cadar w3m-history) 660 (let ((start (w3m-history-plist-get :window-start)) 661 position window) 662 (cond ((and start 663 (setq position (w3m-history-plist-get :position))) 664 (when (<= start (point-max)) 665 (goto-char (point-min)) 666 (forward-line (car position)) 667 (setq window (get-buffer-window (current-buffer) 'all-frames)) 668 (when window 669 (set-window-start window start) 670 (set-window-hscroll 671 window (or (w3m-history-plist-get :window-hscroll) 0))) 672 (move-to-column (cdr position)) 673 (let ((deactivate-mark nil)) 674 (run-hooks 'w3m-after-cursor-move-hook)))) 675 ((w3m-interactive-p) 676 (message "No cursor position saved")))))) 677 678(defun w3m-history-minimize () 679 "Minimize the history so that there may be the current page only." 680 (interactive) 681 (let ((position (cadar w3m-history)) 682 element) 683 (when position 684 (setq element (w3m-history-element position t)) 685 (setcar (cddr element) (list 0)) 686 (setq w3m-history-flat (list element) 687 w3m-history (list (list nil (list 0) nil) 688 (list (car element) (cadr element))))))) 689 690(defun w3m-history-slimmed-history-flat () 691 "Return slimmed history." 692 (let ((position (cadar w3m-history)) 693 flat-map new-flat) 694 (dolist (l w3m-history-flat) 695 (setq flat-map (cons (cons (nth 2 l) l) 696 flat-map))) 697 (setq new-flat (cons (cdr (assoc position flat-map)) nil)) 698 (let ((pos (w3m-history-previous-position position))) 699 (while pos 700 (setq new-flat (cons (cdr (assoc pos flat-map)) 701 new-flat)) 702 (setq pos (w3m-history-previous-position pos)))) 703 (let ((pos (w3m-history-next-position position))) 704 (while pos 705 (setq new-flat (cons (cdr (assoc pos flat-map)) 706 new-flat)) 707 (setq pos (w3m-history-next-position pos)))) 708 new-flat)) 709 710(defun w3m-history-slim () 711 "Slim the history. 712This makes the history slim so that it may have only the pages that 713are accessible by PREV and NEXT operations." 714 (interactive) 715 (let ((position (cadar w3m-history))) 716 (setq w3m-history-flat (w3m-history-slimmed-history-flat)) 717 (w3m-history-tree position))) 718 719(defvar w3m-arrived-db) 720(declare-function w3m-goto-url "w3m" 721 (url &optional reload charset post-data referer handler)) 722 723(defun w3m-history-add-arrived-db () 724 "Add the arrived database to the history structure unreasonably. 725This function is useless normally, so you may not want to use it. 726(The reason it is here is because it is useful once in a while when 727debugging w3m-hist.el.)" 728 (interactive) 729 (unless (eq 'w3m-mode major-mode) 730 (error "`%s' must be invoked from an emacs-w3m buffer" this-command)) 731 (when (and w3m-arrived-db 732 (prog1 733 (yes-or-no-p 734 "Are you sure you really want to destroy the history? ") 735 (message ""))) 736 (setq w3m-history nil 737 w3m-history-flat nil) 738 (let ((w3m-history-reuse-history-elements t) 739 url-title title) 740 (maphash (lambda (_key symbol) 741 (when symbol 742 (if (setq title (get symbol 'title)) 743 (push (list (symbol-name symbol) 744 (list :title title)) 745 url-title) 746 (push (list (symbol-name symbol)) url-title)))) 747 w3m-arrived-db) 748 (apply 'w3m-history-push (nth (random (length url-title)) url-title)) 749 (while url-title 750 (w3m-history-push (car (nth (random (length w3m-history-flat)) 751 w3m-history-flat))) 752 (apply 'w3m-history-push (pop url-title)))) 753 (w3m-goto-url "about://history/" t))) 754 755(provide 'w3m-hist) 756 757;;; w3m-hist.el ends here 758