emacs_el/tiny-tools/tiny/tinydesk.el

   1 ;;; tinydesk.el --- Save and restore files between Emacs sessions
   2
   3 ;; This file is not part of Emacs
   4
   5 ;;{{{ Id
   6
   7 ;; Copyright (C)    1995-2007 Jari Aalto
   8 ;; Keywords:        extensions
   9 ;; Author:          Jari Aalto
  10 ;; Maintainer:      Jari Aalto
  11 ;;
  12 ;; To get information on this program, call M-x tinydesk-version.
  13 ;; Look at the code with folding.el
  14
  15 ;; COPYRIGHT NOTICE
  16 ;;
  17 ;; This program is free software; you can redistribute it and/or modify it
  18 ;; under the terms of the GNU General Public License as published by the Free
  19 ;; Software Foundation; either version 2 of the License, or (at your option)
  20 ;; any later version.
  21 ;;
  22 ;; This program is distributed in the hope that it will be useful, but
  23 ;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  24 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  25 ;; for more details.
  26 ;;
  27 ;; You should have received a copy of the GNU General Public License
  28 ;; along with program; see the file COPYING. If not, write to the
  29 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  30 ;; Boston, MA 02110-1301, USA.
  31 ;;
  32 ;; Visit <http://www.gnu.org/copyleft/gpl.html> for more information
  33
  34 ;;}}}
  35 ;;{{{ Install
  36
  37 ;; ........................................................ &t-install ...
  38 ;;   Put this file on your Emacs-Lisp load path, add following into your
  39 ;;   $HOME/.emacs startup file
  40 ;;
  41 ;;      (add-hook 'tinydesk-:load-hook 'tinydesk-default-emacs-keybindings)
  42 ;;      (add-hook 'tinydesk-:load-hook 'tinydesk-recover-last-state)
  43 ;;      (require 'tinydesk)
  44 ;;
  45 ;;   or use the autoload feature. Notice that the automatic "file
  46 ;;   state backup feature" gets enables only when this file is loaded.
  47 ;;   If you want that feature, then use require.
  48 ;;
  49 ;;      (add-hook 'tinydesk-:load-hook 'tinydesk-default-emacs-keybindings)
  50 ;;      (add-hook 'tinydesk-:load-hook 'tinydesk-recover-last-state)
  51 ;;      (autoload 'tinydesk-mode            "tinydesk" "" t)
  52 ;;      (autoload 'tinydesk-save-state      "tinydesk" "" t)
  53 ;;      (autoload 'tinydesk-unload          "tinydesk" "" t)
  54 ;;      (autoload 'tinydesk-recover-state   "tinydesk" "" t)
  55 ;;      (autoload 'tinydesk-edit-state-file "tinydesk" "" t)
  56 ;;
  57 ;;   Suggested keybindings. These are inlcuded in function
  58 ;;   `tinydesk-default-keybindings'.
  59 ;;
  60 ;;      (define-key ctl-x-4-map "S" 'tinydesk-save-state)
  61 ;;      (define-key ctl-x-4-map "R" 'tinydesk-recover-state)
  62 ;;      (define-key ctl-x-4-map "E" 'tinydesk-edit-state-file)
  63 ;;      (define-key ctl-x-4-map "U" 'tinydesk-unload)
  64 ;;
  65 ;;   If you have any questions, use this function:
  66 ;;
  67 ;;      M-x tinydesk-submit-bug-report
  68 ;;
  69 ;;  To read the documentation after file has been loaded, call
  70 ;;
  71 ;;      M-x tinydesk-version
  72
  73 ;;}}}
  74 ;;{{{ Documentation
  75
  76 ;; ..................................................... &t-commentary ...
  77
  78 ;;; Commentary:
  79
  80 ;;  Preface, feb 1995
  81 ;;
  82 ;;      At work working with windowed system, Emacs stays open from day to
  83 ;;      day. In fact people seldom even logout, so Emacs and the files
  84 ;;      just wait there nicely and there is seldom a need for a sophisticated
  85 ;;      session saver.
  86 ;;
  87 ;;      But sometimes sometimes it may be necessary to visit lab next
  88 ;;      floor to see what's troubling a C++ program. There has to be a way
  89 ;;      to transfer the list of files that was being editing and bring
  90 ;;      them into lab where person can replicate the setup.
  91 ;;
  92 ;;      These functions save Emacs configuration into file, which can later be
  93 ;;      opened again in Emacs somewhere else. Later Emacs versions
  94 ;;      introduced "~/.saves*" files that you may find disturbing occupying
  95 ;;      your home directory with many files. With this package all the
  96 ;;      files are grouped in only one "state" state file, which can be reused.
  97 ;;
  98 ;;      Hopefully someone finds use for this also, although there exist
  99 ;;      much more better desktop savers, which save points, marks and
 100 ;;      modes.
 101 ;;
 102 ;;  Overview of features
 103 ;;
 104 ;;      o   Simple desktop: only filenames and directories are read/saved.
 105 ;;          Unlike the other desktop savers, this one can also UNLOAD files
 106 ;;          from Emacs. You just tell it to remove 'these files listed in
 107 ;;          state file state.XXX', and those files will be removed from
 108 ;;          your Emacs buffers. You can collect 'projects' and switch
 109 ;;          between them easily: after project1, It can can be unload and
 110 ;;          load project3 instead.
 111 ;;
 112 ;;      o   Parse any file that includes filenames and comments
 113 ;;
 114 ;;      o   If there were any invalid entries in the state file,
 115 ;;          the state file contents is shown to user and the entries which
 116 ;;          had problems are marked.
 117 ;;
 118 ;;      o   State file editing (tinydesk-mode):
 119 ;;
 120 ;;          --  load single file on the line
 121 ;;          --  clear face properties from buffer, so that they don't
 122 ;;              disturb your view.
 123 ;;          --  parse files for loading.
 124 ;;          --  Show files that cannot be loaded.
 125 ;;
 126 ;;      o   In regular intervals save the state of Emacs (files loaded)
 127 ;;          If Emacs crashes you can recover the previous session.
 128 ;;          See function `tinydesk-auto-save' for more. Similar functionality
 129 ;;          (".saves") is in new Emacs releases, but this package
 130 ;;          was originally written using 19.28
 131 ;;
 132 ;;      o   CRASH RECOVERY: If Emacs crashes, or you have to kill it
 133 ;;          with `-HUP' if it hangs, it leaves autosaved files around. When
 134 ;;          you boot up again, you need to reload the existing files AND
 135 ;;          recover any autosaved files. The best way to get your Emacs
 136 ;;          back where it was, is that you load the state file for editing:
 137 ;;          `M-x' `tinydesk-edit-state-file' And from the edit
 138 ;;          mode hit command `tinydesk-find-file-whole-buffer' which is
 139 ;;          bound to C-c b and `tinydesk-recover-file-whole-buffer' which
 140 ;;          is bound to C-c B. And you'll be up again with your latest
 141 ;;          files.
 142 ;;
 143 ;;  Quick start
 144 ;;
 145 ;;      If you're just eager to use the package, here are the basics.
 146 ;;      I suppose you have copied the installation setup as is.
 147 ;;
 148 ;;      o   You have Emacs session open with bunch of files. Now you
 149 ;;          believe that it's time to save this session. You do
 150 ;;          C-x 4 s and give some name "state.c" if you edited c project.
 151 ;;
 152 ;;      Now, it all depends what you want to do after that. If you find more
 153 ;;      files to Emacs; or kill some unwanted buffers, you can re-execute
 154 ;;      C-x 4 s whenever you like. You can even edit the state file with
 155 ;;      C-x 4 e to remove some files that you don't want to include to
 156 ;;      that "project".
 157 ;;
 158 ;;      o   Next time you open Emacs you can load any state file with
 159 ;;          C-x 4 r "state.c"
 160 ;;
 161 ;;      If you want to switch between projects; unload first the current
 162 ;;      project with C-x 4 u "state.c" and reload some other project
 163 ;;      with C-x 4 r, eg your current C++ project "state.cc"
 164 ;;
 165 ;;  Automatic one time session saver
 166 ;;
 167 ;;      Some people just want to save the session on exit and reopen it
 168 ;;      when Emacs starts again. I must say that this is not necessarily
 169 ;;      the best, because when you start Emacs for some quick job, you
 170 ;;      don't necessarily want it to load the saved session (loading all
 171 ;;      files take time considerably). Loading Emacs with -q is not the
 172 ;;      choice, if you still like to have your other Emacs goodies active.
 173 ;;
 174 ;;      Here is semi-automatic save and restore, put all these lines near
 175 ;;      the end of your $HOME/.emacs. The setup saves the state when
 176 ;;      Emacs exists and asks if you want to return to saved session on
 177 ;;      Emacs startup. (You did also copy the installation lines too...)
 178 ;;
 179 ;;          (defconst tinydesk-:directory-location "~/elisp/config")
 180 ;;
 181 ;;          (defconst my-tinydesk-session
 182 ;;            (concat tinydesk-:directory-location "/state.last-session"))
 183 ;;
 184 ;;          (add-hook 'kill-emacs-hook 'my-save-session)
 185 ;;
 186 ;;          (defun my-save-session ()
 187 ;;            "Save loaded files to state file."
 188 ;;            ;;  if you want to save dired buffers too.
 189 ;;            ;;  use (tinydesk-save-state my-tinydesk-session '(4))
 190 ;;            (tinydesk-save-state my-tinydesk-session) nil)
 191 ;;
 192 ;;          (if (and (file-exists-p my-tinydesk-session)
 193 ;;                   (y-or-n-p "Recover session "))
 194 ;;              (tinydesk-recover-state my-tinydesk-session))
 195 ;;
 196 ;;  Face setup
 197 ;;
 198 ;;      This program uses some faces to catch your attention when you're
 199 ;;      working with the state files. I you restore state from a file and
 200 ;;      some file reference cannot be loaded, the state file will be shown
 201 ;;      to you and the problematic lines are highlighted. If you open the
 202 ;;      state file for editing, you can selectively load files. The mouse
 203 ;;      pointer will change and the text is again highlighted. To make the
 204 ;;      highlight work for you, you must set some colors like this
 205 ;;
 206 ;;         (set-face-foreground 'italic "LightBlue")
 207 ;;
 208 ;;  About saving the files
 209 ;;
 210 ;;      While you may save your session files with any name, here is one
 211 ;;      convention that you could use. Name every filename so, that they
 212 ;;      have common prefix:
 213 ;;
 214 ;;          M-x tinydesk-save-state   ;; or any hotkey you have bound this to
 215 ;;          state.XXX
 216 ;;
 217 ;;      The XXX describes the name of the state file you just saved. Later
 218 ;;      on it's easier to use Emacs file name completion capability to load
 219 ;;      the file you want. If you don't exactly remember what files you
 220 ;;      saved, or which sessions you have in dir, you just type
 221 ;;
 222 ;;          state.[TAB]
 223 ;;
 224 ;;      when `tinydesk-recover-state' ask for filename.
 225 ;;      Prefix arg to `tinydesk-save-state saves' says to load directories too.
 226 ;;
 227 ;;  Automatic state file saving
 228 ;;
 229 ;;      Emacs 19.29+ has feature that makes it possible to recover a session.
 230 ;;      See bunch of `auto-save-list-*' variables.
 231 ;;
 232 ;;      Has it ever happened to you that Emacs crashed mystically when you
 233 ;;      were in the middle of your daily routines. You had several C++
 234 ;;      files open, perl code, text files, RMAIL, ... This package installs
 235 ;;      `tinydesk-auto-save' function to `write-file-hooks' and in regular
 236 ;;      intervals all your Emacs session files are stored into the state
 237 ;;      file. After a crash you can easily recover your session by reading
 238 ;;      the saved state file information with `tinydesk-recover-state'
 239 ;;      <FILE>. The name of the file of the latest saved state is in file
 240 ;;      "periodic"
 241 ;;
 242 ;;  Development note
 243 ;;
 244 ;;      There is no plan to duplicate *desktop.el* functionality to save points
 245 ;;      and modes and so on. This is for simple state restoring only.
 246
 247 ;;}}}
 248
 249 ;;; Change Log:
 250
 251 ;;; Code:
 252
 253 (require 'tinylibm)
 254
 255 (eval-when-compile (ti::package-use-dynamic-compilation))
 256
 257 (ti::package-defgroup-tiny TinyDesk tinydesk-: extensions
 258   "Simple desktop: only filenames and directories are read/saved.
 259
 260             Unlike the other desktop savers, this one can also UNLOAD files
 261             from Emacs. You just tell it to remove 'these files listed in
 262             state file state.XXX', and those files will be removed from
 263             your Emacs buffers. You can collect 'projects' and switch
 264             between them easily: after project1, It can can
 265             be unload and load project3 instead.
 266
 267             Files that have been modified are not unloaded.
 268     ")
 269
 270 ;;{{{ setup: hooks
 271
 272 ;;; ......................................................... &v-hooks ...
 273
 274 (defcustom tinydesk-:mode-define-keys-hook
 275   '(tinydesk-default-mode-bindings)
 276   "*List of functions to run which define keys to `tinydesk-mode-map'."
 277   :type  'hook
 278   :group 'TinyDesk)
 279
 280 (defcustom tinydesk-:load-hook nil
 281   "*Hook run when file has been loaded."
 282   :type  'hook
 283   :group 'TinyDesk)
 284
 285 (defcustom tinydesk-:save-before-hook nil
 286   "*Hook run just before _writing_ files to STATE file.
 287 begins. This is your chance to do something to the buffers."
 288   :type  'hook
 289   :group 'TinyDesk)
 290
 291 (defcustom tinydesk-:save-after-hook nil
 292   "*Hook just before _saving_ of STATE file.
 293 The files are there, possibly in sorted order, and the title is there."
 294   :type  'hook
 295   :group 'TinyDesk)
 296
 297 (defcustom tinydesk-:mode-hook nil
 298   "*Hook run after the `tinydesk-mode' is turned on."
 299   :type  'hook
 300   :group 'TinyDesk)
 301
 302 (defcustom tinydesk-:recover-before-hook nil
 303   "*Hook run after recover file is loaded, just before processing start."
 304   :type  'hook
 305   :group 'TinyDesk)
 306
 307 (defcustom tinydesk-:recover-after-hook nil
 308   "*Hook run after recover file is _parsed_ AND no errors during load."
 309   :type  'hook
 310   :group 'TinyDesk)
 311
 312 ;;}}}
 313 ;;{{{ setup: user config
 314
 315 ;;; ................................................... &v-user-config ...
 316
 317 (defcustom tinydesk-:comment-characters ";#"
 318   "*A string containing comment start characters in state file.
 319 The default value is ';#'."
 320   :type  'string
 321   :group 'TinyDesk)
 322
 323 (defcustom tinydesk-:mode-name "TinyDesk"
 324   "*Editing STATE files mode name."
 325   :type  'string
 326   :group 'TinyDesk)
 327
 328 (defcustom tinydesk-:directory-location
 329   (or
 330    (file-name-as-directory
 331     (file-name-directory (ti::package-config-file-prefix "tinydesk.el")))
 332    (and (file-directory-p "~/tmp")
 333         "~/tmp")
 334    (error "\
 335 TinyDesk: Can't set default value for `tinydesk-:directory-location'"))
 336   "*Default directory where to save and restore files."
 337   :type 'directory
 338   :group 'TinyDesk)
 339
 340 (defcustom tinydesk-:directory-save-suggested 'default
 341   "*How the state file's directory location is suggested.
 342 'last        Offer last saved directory.
 343 'default     Always offer the default directory `tinydesk-:directory-location'"
 344   :type  '(choice
 345            (const last)
 346            (const default))
 347   :group 'TinyDesk)
 348
 349 (defcustom tinydesk-:auto-save-interval 5
 350   "*Interval between doing auto-save of Emacs state.
 351 If set to 5, after every 5th `write-file' the state is saved.
 352
 353 The interval cannot be smaller than 5. It is reseted to 10 if
 354 it's smaller than 5.
 355
 356 See variable `tinydesk-:auto-save-name-function' and
 357 function `tinydesk-auto-save' for more information."
 358   :type  '(integer :tag "Save interval")
 359   :group 'TinyDesk)
 360
 361 (defcustom tinydesk-:auto-save-name-function  nil
 362   "*Function to return a full path name for auto-save file.
 363 If this variable is nil, then default name is derived from frame's
 364 first element and it used in `tinydesk-:directory-location'
 365
 366 For full documentation, see function `tinydesk-auto-save'"
 367   :type 'function
 368   :group 'TinyDesk)
 369
 370 (defcustom tinydesk-:save-exclude-regexp
 371   (concat
 372
 373    ;;  Do save mail buffers; because you want to call M-x rmail
 374    ;;  instead.
 375
 376    "RMAIL\\|VM\\|MH"
 377
 378    ;;  No ange ftp buffers
 379
 380    "\\(ftp\\|anonymous\\)@.*/"
 381
 382    ;;  No files from these directories
 383
 384    "\\|^/tmp/\\|/junk/\\|/trash/\\|/[aA]utosaved?/")
 385   "*Regexp of files that are not saved to state file.
 386 match is case sensitive. If you do want not case sensitive match, you
 387 have to do set this variable to nil and use your own line delete:
 388
 389    (setq tinydesk-:save-after-hook      'my-tinydesk-:save-after-hook)
 390    (defun my-tinydesk-:save-after-hook ()
 391       (flush-lines REGEXP))"
 392
 393   :type  '(string :tag "Regexp")
 394   :group 'TinyDesk)
 395
 396 (defcustom tinydesk-:save-title
 397   '(progn
 398      (format
 399       (concat
 400        ";; Emacs tinydesk.el state file\n"
 401        ";;\n"
 402        ";;\n"
 403        ";;       M-x load-library RET tinydesk RET\n"
 404        ";;       M-x tinydesk-version RET   <<to read manual>>\n"
 405        ";;       M-x tinydesk-recover-state RET %s RET"
 406        "\n\n")
 407       (ti::date-standard-date 'short)
 408       (if (boundp 'file)
 409           file ;; visible in function `tinydesk-save-state'
 410         "")))
 411   "*A lisp form to return a string to the beginning of state file."
 412   :type  'sexp
 413   :group 'TinyDesk)
 414
 415 (defcustom tinydesk-:save-and-sort t
 416   "*Non-nil to sort the file list in state file.
 417 nil to preserve `buffer-list' order."
 418   :type  'boolean
 419   :group 'TinyDesk)
 420
 421 ;;  Set to nil if you don't want title.
 422
 423 (defcustom tinydesk-:get-save-file-function 'tinydesk-get-save-files
 424   "*Function to return list of filenames that are stored to state file.
 425 This function isn't run if `tinydesk-save-state' is explicitely
 426 run with parameter FILES.
 427
 428 Arguments passed to function:
 429   mode          flag passed by `tinydesk-save-state'"
 430
 431   :type  'function
 432   :group 'TinyDesk)
 433
 434 (defcustom tinydesk-:face-table
 435   '((file-pick .  highlight)
 436     (error     .  italic))
 437   "*Alist of faces used for marking text.
 438 The default value is
 439
 440 \(setq tinydesk-:face-table
 441   '((file-pick .  highlight)
 442     (error     .  italic)))"
 443   :type '(list
 444           (cons
 445            (const  file-pick)
 446            (symbol :tag "Face"))
 447           (cons
 448            (const error)
 449            (symbol :tag "Face")))
 450   :group 'TinyDesk)
 451
 452 ;;}}}
 453 ;;{{{ setup: -- private
 454
 455 ;;; ....................................................... &v-private ...
 456
 457 (defvar tinydesk-mode-map nil
 458   "Local keymap for STATE files loaded by edit.")
 459
 460 (defvar tinydesk-:directory-last nil
 461   "Directory that was used for last save.")
 462
 463 (defvar tinydesk-:tmp-buffer "*tmp*"
 464   "The work buffer used, created and killed when needed.")
 465
 466 (defvar tinydesk-:trash-tmp-buffer  t
 467   "If non-nil, the work buffer is always deleted.")
 468
 469 (defvar tinydesk-:message-column 60
 470   "Column where to put possible messages regarding file.")
 471
 472 (defvar tinydesk-:auto-save-counter 0
 473   "Counter incremented every every time `write-file' event happens.
 474 See. `tinydesk-auto-save'.")
 475
 476 (defconst tinydesk-:loaded-file-list nil
 477   "Overwritten when files are loaded. List.
 478 Contain files that were loaded by `tinydesk-find-file-whole-buffer'.
 479 Hooks may check the contents of this.")
 480
 481 (defconst tinydesk-:rejected-file-list nil
 482   "Overwritten when files are loaded. List.
 483 Contain files that were *not* loaded by
 484 `tinydesk-find-file-whole-buffer'. Reason may be anything: incorrect filename,
 485 path, garbage at line...Hooks may check the contents of this.")
 486
 487 (defconst tinydesk-:comment-start-level 1
 488   "Which sub expression is the comment start.")
 489
 490 (defvar tinydesk-:last-state-file  nil
 491   "Last state file loaded is stored here.")
 492
 493 ;;}}}
 494 ;;{{{ setup: -- version
 495
 496 ;;; ....................................................... &v-version ...
 497
 498 ;;;###autoload (autoload 'tinydesk-version "tinydesk" "Display commentary." t)
 499 (eval-and-compile
 500   (ti::macrof-version-bug-report
 501    "tinydesk.el"
 502    "tinydesk"
 503    tinydesk-:version-id
 504    "$Id: tinydesk.el,v 2.52 2007/05/06 23:15:19 jaalto Exp $"
 505    '(tinydesk-version-id
 506      tinydesk-:mode-define-keys-hook
 507      tinydesk-mode-map
 508      tinydesk-:load-hook
 509      tinydesk-:save-before-hook
 510      tinydesk-:save-after-hook
 511      tinydesk-:mode-hook
 512      tinydesk-:recover-before-hook
 513      tinydesk-:recover-after-hook
 514      tinydesk-:directory-last
 515      tinydesk-:tmp-buffer
 516      tinydesk-:trash-tmp-buffer
 517      tinydesk-:message-column
 518      tinydesk-:loaded-file-list
 519      tinydesk-:rejected-file-list
 520      tinydesk-:comment-start-level
 521      tinydesk-:mode-name
 522      tinydesk-:directory-save-suggested
 523      tinydesk-:save-exclude-regexp
 524      tinydesk-:comment-characters
 525      tinydesk-:save-title
 526      tinydesk-:save-and-sort
 527      tinydesk-:face-table)))
 528
 529 ;;}}}
 530 ;;{{{ Install: bindings
 531
 532 ;;; ----------------------------------------------------------------------
 533 ;;;
 534 (defun tinydesk-default-emacs-keybindings ()
 535   "Install package under `ctl-x-4-map'
 536 \\{ctl-x-4-map}"
 537   (interactive)
 538   (define-key ctl-x-4-map "S" 'tinydesk-save-state) ;; free in Emacs
 539   ;;  This was find-file-read-only-other-window
 540   (define-key ctl-x-4-map "R" 'tinydesk-recover-state)   ;; Not free
 541   (define-key ctl-x-4-map "E" 'tinydesk-edit-state-file) ;; free in Emacs
 542   (define-key ctl-x-4-map "U" 'tinydesk-unload)) ;; free in Emacs
 543
 544 ;;; ----------------------------------------------------------------------
 545 ;;;
 546 (defun tinydesk-default-mode-bindings ()
 547   "Define default key bindings to `tinydesk-mode-map'."
 548   (when (ti::emacs-p)
 549     ;;  - Don't want to use mouse-2 because it's for PASTE.
 550     ;;  - The others are put to mouse-2 because there is not
 551     ;;    not always 3 button mouse available.
 552
 553     (define-key tinydesk-mode-map [mouse-3] 'tinydesk-mouse-load-file)
 554
 555     ;;  - When editing a file, those colors might be too annoyinng,
 556     ;;    so you can remove properties with this. Loading is disabled too
 557     ;;  - Remeber, Emacs is slow with this... wait some time.
 558
 559     (define-key tinydesk-mode-map [S-mouse-2]
 560       'tinydesk-clear-buffer-properties)
 561
 562     ;;  To make buffer loadable by mouse again, run this
 563
 564     (define-key tinydesk-mode-map [C-mouse-2]
 565       'tinydesk-mark-buffer-loadable)
 566
 567     ;;  To mark files that are not loadable, check for possibly typo in
 568     ;;  filename
 569
 570     (define-key tinydesk-mode-map [C-M-mouse-2]
 571       'tinydesk-set-face-non-files-buffer))
 572
 573   (when (ti::xemacs-p)
 574
 575     (define-key tinydesk-mode-map [(button3)]
 576       'tinydesk-mouse-load-file)
 577
 578     (define-key tinydesk-mode-map [(shift button2)]
 579       'tinydesk-clear-buffer-properties)
 580
 581     (define-key tinydesk-mode-map [(control button2)]
 582       'tinydesk-mark-buffer-loadable)
 583
 584     (define-key tinydesk-mode-map [(control alt button2)]
 585       'tinydesk-set-face-non-files-buffer))
 586
 587   ;; ............................................. users with no mouse ...
 588
 589   (define-key tinydesk-mode-map "\C-c\C-m" 'tinydesk-load-file)
 590
 591   (define-key tinydesk-mode-map "\C-cc" 'tinydesk-clear-buffer-properties)
 592   (define-key tinydesk-mode-map "\C-cl" 'tinydesk-mark-buffer-loadable)
 593   (define-key tinydesk-mode-map "\C-cn" 'tinydesk-set-face-non-files-buffer)
 594   (define-key tinydesk-mode-map "\C-cu" 'tinydesk-unload-current-file)
 595   (define-key tinydesk-mode-map "\C-cx" 'tinydesk-expunge-unloaded)
 596   (define-key tinydesk-mode-map "\C-cr" 'tinydesk-remove-file-coments)
 597   (define-key tinydesk-mode-map "\C-cb" 'tinydesk-find-file-whole-buffer)
 598   (define-key tinydesk-mode-map "\C-cB" 'tinydesk-recover-file-whole-buffer))
 599
 600 ;;}}}
 601 ;;{{{ code: misc
 602
 603 ;;; ----------------------------------------------------------------------
 604 ;;;
 605 (defsubst tinydesk-comment ()
 606   "Return comment."
 607   (make-string
 608    2
 609    (string-to-char
 610     (substring tinydesk-:comment-characters 0 1 ))))
 611
 612 ;;; ----------------------------------------------------------------------
 613 ;;;
 614 (defsubst tinydesk-comment-re ()
 615   "Return comment regexp."
 616   (concat "[^\n"
 617           tinydesk-:comment-characters
 618           "]*\\(["
 619           tinydesk-:comment-characters
 620           "].*\\)"))
 621
 622 ;;; ----------------------------------------------------------------------
 623 ;;;
 624 (defsubst tinydesk-read-word ()
 625   "Read filename word."
 626   ;;   Windows use spaces in file names
 627   (ti::remove-properties
 628    (ti::string-remove-whitespace
 629     (ti::buffer-read-word "- a-zA-Z0-9_/.!@#%&{}[]+:;~`<>"))))
 630
 631 ;;; ----------------------------------------------------------------------
 632 ;;;
 633 (defsubst tinydesk-tmp-buffer (&optional clear)
 634   "Return temp buffer. optionally CLEAR it."
 635   (ti::temp-buffer tinydesk-:tmp-buffer clear))
 636
 637 ;;; ----------------------------------------------------------------------
 638 ;;;
 639 (defsubst tinydesk-file-name-absolute  (file)
 640   "Add `default-directory' to FILE if it has no directory."
 641   (if file
 642       (if (not (string-match "/" (or file "")))
 643           (setq file (concat default-directory file))))
 644   file)
 645
 646 ;;; ----------------------------------------------------------------------
 647 ;;;
 648 (defsubst tinydesk-mode-map-activate ()
 649   "Use local \\{tinydesk-mode-map} on this buffer."
 650   (use-local-map tinydesk-mode-map))
 651
 652 ;;; ----------------------------------------------------------------------
 653 ;;;
 654 (defun tinydesk-get-save-dir ()
 655   "Return suggested save directory."
 656   (let* ((type      tinydesk-:directory-save-suggested)
 657          (last      tinydesk-:directory-last)
 658          (dir       tinydesk-:directory-location)
 659          (ret       dir))               ;set default return value
 660     (if (and (eq type 'last)
 661              (stringp last)
 662              (file-writable-p last))
 663         (setq ret last))
 664     (or ret
 665         dir
 666         "~/")))
 667
 668 ;;; ----------------------------------------------------------------------
 669 ;;;
 670 (defun tinydesk-only-files-buffer ()
 671   "Remove all comments and empty lines from buffer and leave 1st word."
 672   (interactive)
 673   (tinydesk-only-files-region (point-max) (point-min)))
 674
 675 ;;; ----------------------------------------------------------------------
 676 ;;;
 677 (defun tinydesk-only-files-region (beg end)
 678   "Remove comments BEG END and empty lines from region and leave 1st word.
 679 This way you can rip off all comments and leave filenames."
 680   (interactive "r")
 681   (let* ((sub-level     tinydesk-:comment-start-level)
 682          (comment-re    (tinydesk-comment-re))
 683          (empty-re      "^[ \t]*$\\|$")
 684          mark-end
 685          p
 686          maxp
 687          word
 688          tmp)
 689     (if (> beg end)
 690         (setq tmp beg  beg end  end tmp))
 691     (save-excursion
 692       (goto-char end)
 693       ;;  markers has to be used, beacuse we delete lines and points move
 694       (setq mark-end (point-marker))
 695       (goto-char beg)
 696       (while (< (point) (marker-position mark-end))
 697         (setq p (point)  maxp nil)
 698         (catch 'next
 699           (if (null (looking-at empty-re))
 700               nil
 701             (ti::buffer-kill-line)
 702             (throw 'next t))
 703           (if (null (looking-at comment-re))
 704               nil
 705             (if (match-beginning sub-level)
 706                 (setq maxp (match-beginning sub-level))))
 707           (if (and maxp (eq maxp p))    ;BEG of line comment
 708               (progn
 709                 (ti::buffer-kill-line) (throw 'next t)))
 710           (setq word (tinydesk-read-word))
 711 ;;;       (setq word (tinydesk-read-word p maxp))
 712           (ti::buffer-kill-line)
 713           ;; The \n make cursor forward
 714           (if word
 715               (insert word "\n")))))))
 716
 717 ;;; ----------------------------------------------------------------------
 718 ;;;
 719 (defun tinydesk-trash ()
 720   "Kill temporary buffer if user has requested it.
 721
 722 References:
 723   `tinydesk-:tmp-buffer'
 724   `tinydesk-:trash-tmp-buffer'"
 725   (and tinydesk-:trash-tmp-buffer
 726        (get-buffer tinydesk-:tmp-buffer)
 727        (kill-buffer  (get-buffer tinydesk-:tmp-buffer))))
 728
 729 ;;; ----------------------------------------------------------------------
 730 ;;;
 731 (defun tinydesk-dired-table  ()
 732   "Return dired buffer table '((directory  dired-buffer) ...)."
 733   (interactive)
 734   (let ((blist   (buffer-list))
 735         ;;  ByteCompiler doesn't know that I do
 736         ;;  (eq major-mode 'dired-mode) test before I use this variable,
 737         ;;  so hide it from it.
 738         ;;
 739         ;;  The variable is defined if it passed the eq test
 740         (sym     'dired-directory)
 741         list)
 742     (dolist (elt blist)
 743       (with-current-buffer elt
 744         (if (eq major-mode 'dired-mode)
 745             (push
 746              (list (symbol-value sym)
 747                    (current-buffer))
 748              list))))
 749     list))
 750
 751 ;;}}}
 752 ;;{{{ code: auto save
 753
 754 ;;; ----------------------------------------------------------------------
 755 ;;;
 756 (defun tinydesk-auto-save-file-name ()
 757   "Return state file name for auto save. See function `tinydesk-auto-save'.
 758 References:
 759   `tinydesk-:directory-location'
 760   `tinydesk-:auto-save-name-function'."
 761   (let* ((func       tinydesk-:auto-save-name-function)
 762          (dir        (or tinydesk-:directory-location "~" ))
 763          (name       (or (and (boundp 'command-line-args)
 764                               (nth 1 (member "-name" command-line-args)))
 765                          "periodic"))
 766          (fn         (concat
 767                       (file-name-as-directory dir)
 768                       "emacs-config-tinydesk-autosave-"
 769                       (or name "saved"))) ;; default
 770          (save-to    fn))
 771     (if func
 772         (setq save-to (funcall func)))
 773     save-to))
 774
 775 ;;; ----------------------------------------------------------------------
 776 ;;;
 777 (defun tinydesk-auto-save (&optional force)
 778   "This function is installed in `write-file-hooks'. Periodic auto save.
 779
 780 Input:
 781
 782   FORCE     Do autosave immediately
 783
 784 Every Nth time the state of the Emacs  (which files were loaded into Emacs)
 785 is saved, so that you can recover the same session if Emacs crashes.
 786
 787 The default state name is derived in the following manner
 788
 789 o  use directory `tinydesk-:directory-location'
 790 o  add string \"emacs-tinydesk-autosave-\"
 791 o  get frame's first word, usually the one that gets set when
 792    you use -name XXX switch in Emacs command line. If Emacs is being
 793    run with -nw option, the frame name returns \"terminal\"
 794 o  if there is no frame name, then use \"periodic\"
 795
 796    Possible yielding: ~/elisp/config/state.saved
 797
 798 References:
 799
 800   `tinydesk-:auto-save-counter'
 801   `tinydesk-:auto-save-interval'       every Nth write"
 802   (interactive "P")
 803   (let* ((backup-inhibited t)
 804          (save-to    (tinydesk-auto-save-file-name)))
 805     (when (stringp save-to)
 806       ;;  - Be extra careful, because we're in write file hook
 807       ;;  - Make sure we always succeed
 808       (if (not (integerp tinydesk-:auto-save-counter)) ;; init if not int
 809           (setq tinydesk-:auto-save-counter 0))
 810       (if (not (integerp tinydesk-:auto-save-interval)) ;; user didn't set this?
 811           (setq tinydesk-:auto-save-interval 10))
 812       (if (< tinydesk-:auto-save-interval 5) ;; Must be more than 5
 813           (setq tinydesk-:auto-save-interval 10))
 814       (incf tinydesk-:auto-save-counter)
 815       ;;  time's up? Select name if it's string.
 816       (cond
 817        ((or force
 818             (> tinydesk-:auto-save-counter tinydesk-:auto-save-interval))
 819         ;;   Actually tinydesk-save-state generates new call to this
 820         ;;   function but, it won't come in this COND, because the counter
 821         ;;   value is different.
 822         (setq tinydesk-:auto-save-counter 0)
 823         ;; Try chmod, if it fails, then signal error
 824         (if (and (file-exists-p save-to)
 825                  (not (file-writable-p save-to)))
 826             (set-file-modes
 827              save-to
 828              (ti::file-mode-make-writable (file-modes save-to))))
 829         ;;  Still no luck after chmod ?
 830         (if (or (not (file-directory-p (file-name-directory save-to)))
 831                 (and (file-exists-p save-to)
 832                      (not (file-writable-p save-to))))
 833             (error "\
 834 TinyDesk: Can't do state autosave: [%s] is not writable." save-to))
 835
 836         (save-window-excursion
 837           (save-excursion
 838             (message "TinyDesk: state backup in file %s" save-to)
 839             (tinydesk-save-state save-to)))))
 840       ;; `write-file-hook' function must return nil
 841       nil)))
 842
 843 ;;}}}
 844
 845 ;;{{{ Code: faces
 846
 847 ;;; ----------------------------------------------------------------------
 848 ;;;
 849 (defun tinydesk-face (face)
 850   "Return FACE."
 851   ;;  This way the global variable does not float around the file
 852   (cdr (assoc face tinydesk-:face-table)))
 853
 854 ;;; ----------------------------------------------------------------------
 855 ;;;
 856 (defun tinydesk-clear-line-properties ()
 857   "Remove properties from the line."
 858   (set-text-properties (line-beginning-position) (line-end-position) nil)
 859   (set-buffer-modified-p nil))
 860
 861 ;;; ----------------------------------------------------------------------
 862 ;;;
 863 (defun tinydesk-clear-buffer-properties ()
 864   "Remove properties and EOL comments from buffer."
 865   (interactive)
 866   (let* ((c-chars       tinydesk-:comment-characters)
 867          (c-lev         tinydesk-:comment-start-level)
 868          (c-re          (tinydesk-comment-re)))
 869     (tinydesk-clear-region-properties (point-min) (point-max))
 870     (save-excursion
 871       (ti::pmin)
 872       (while (not (eobp))
 873
 874         ;;  Skip over BOL comments
 875         (if (and (not (looking-at (concat "^[ \t]*[" c-chars "]+\\|$")))
 876                  (looking-at c-re)
 877                  (match-beginning c-lev))
 878             (delete-region (match-beginning c-lev) (line-end-position)))
 879         (forward-line 1)))
 880     (set-buffer-modified-p nil)
 881     (message "TinyDesk: *properties cleared from buffer")
 882     ;;  Little nasty, but Emacs does not update display always...
 883     (redraw-display)))
 884
 885 ;;; ----------------------------------------------------------------------
 886 ;;;
 887 (defun tinydesk-clear-region-properties (beg end)
 888   "Remove properties from BEG END."
 889   (set-text-properties beg end nil)
 890   (set-buffer-modified-p nil))
 891
 892 ;;; ----------------------------------------------------------------------
 893 ;;;
 894 (defun tinydesk-line-property-set-error ()
 895   "Set line face to signify error."
 896   (let* (beg
 897          end)
 898     (save-excursion
 899       (beginning-of-line)               (setq beg (point))
 900       (skip-chars-forward "^ \t\n")     (setq end (point)))
 901     ;; clear first full line
 902     (put-text-property beg (line-end-position) 'face 'default)
 903     (put-text-property beg end 'face (tinydesk-face 'error))
 904     (set-buffer-modified-p nil)))
 905
 906 ;;; ----------------------------------------------------------------------
 907 ;;;
 908 (defun tinydesk-handle-text-property (p text)
 909   "Look property P and run command under TEXT."
 910   (let* ((file       (file-name-nondirectory text))
 911          (loaded     (get-buffer file)) ;in Emacs already ?
 912          (comment    (tinydesk-comment))
 913          (err-col    tinydesk-:message-column))
 914     ;;  We need the sleep-for, because moving the mouse
 915     ;;  clears the message and user may not notice it.
 916     (cond
 917      ((eq p (tinydesk-face 'file-pick))
 918       (cond
 919        ((null (file-exists-p text))
 920         (message (concat "TinyDesk: File not exist, " text)) (sleep-for 0)
 921         (tinydesk-clear-line-properties))
 922        (loaded
 923         (message "TinyDesk: File already loaded.") (sleep-for 0)
 924         (tinydesk-clear-line-properties))
 925        (t
 926         (find-file-noselect text)
 927         (message "TinyDesk: Loaded ok.") (sleep-for 0)
 928         (tinydesk-clear-line-properties)
 929         (move-to-column err-col t)
 930         (if (not (looking-at "$\\|[ \t]*$"))
 931             (end-of-line))
 932         (insert comment " loaded")
 933         (beginning-of-line)))))))
 934
 935 ;;; ----------------------------------------------------------------------
 936 ;;;
 937 (defun tinydesk-mark-buffer-loadable (&optional verb)
 938   "Parse whole buffer and make first _word_ loadable with mouse. VERB.
 939 Marking is only done if word is valid filename."
 940   (interactive)
 941   (save-excursion
 942     (tinydesk-mark-region
 943      (point-min) (point-max)
 944      (tinydesk-comment-re)
 945      tinydesk-:comment-start-level
 946      (or (interactive-p)
 947          verb))))
 948
 949 ;;; ----------------------------------------------------------------------
 950 ;;;
 951 (defun tinydesk-set-face-non-files-buffer  ()
 952   "Change face to 'error in those lines whose first word is not valid file."
 953   (interactive)
 954   (tinydesk-set-face-non-files-region (point-min) (point-max))
 955   (if (interactive-p)
 956       (message "TinyDesk: marked non-lodable files")))
 957
 958 ;;; ----------------------------------------------------------------------
 959 ;;;
 960 (defun tinydesk-set-face-non-files-region (beg end)
 961   "Change face to 'error in those lines whose first word is not valid file.
 962 Also add comment marker for user that do not have highlight capability.
 963 Region is BEG END."
 964   (interactive "r")
 965   (let* ((empty-re      "^[ \t]*$")
 966          (sub-level     tinydesk-:comment-start-level)
 967          (c-chars       tinydesk-:comment-characters)
 968          (comment       (tinydesk-comment))
 969          (comment-re    (tinydesk-comment-re))
 970          (err-col       tinydesk-:message-column)
 971          word)
 972     (save-excursion
 973       (save-restriction
 974         (narrow-to-region beg end)
 975         (ti::pmin)
 976         (while (not (eobp))
 977           ;;  - ignore empty lines and BEG of line comments.
 978           (if (or (looking-at empty-re)
 979                   (and (looking-at comment-re)
 980                        (eq (match-beginning sub-level) (point))))
 981               nil
 982             (setq word (tinydesk-read-word))
 983             (if (and word (file-exists-p word))
 984                 nil
 985 ;;;         (ti::d! word)
 986               (tinydesk-line-property-set-error) ;put color on line
 987               ;;  Show to user that does not see the color
 988               (move-to-column err-col t)
 989               ;; Is the filename that long, that it goes past err-col ?
 990               (cond
 991                ((eq (point) (line-end-position))) ;do nothing
 992                ((looking-at (concat "[ \t" c-chars "]"))
 993                 (kill-line))            ;delete other marks
 994                (t                 ;no other choices. place is cccupied
 995                 (end-of-line)
 996                 (insert " ")))          ;separate word
 997               (insert (concat comment " invalid"))))
 998           (forward-line 1))))))
 999
1000 ;;; ----------------------------------------------------------------------
1001 ;;; - This function is not general.
1002 ;;; #todo: rewrite it for this module only
1003 ;;;
1004 (defun tinydesk-mark-region (beg end &optional com-re sub-level verb)
1005   "Make all filenames in the buffer loadable by mouse.
1006 Supposes that the first _word_ on the line is filename.
1007 If the first word isn't loadable file, its face isn't changed.
1008 If there is no directory part, then `default-directory' is supposed.
1009
1010 Input:
1011
1012   BEG END   region
1013
1014   COM-RE    the file can have comments, but comments can be only
1015             _single span type_, that is, only shell like #, or C++
1016             like //. Everything after and included  COM-RE is discarded
1017             from SUB-LEVEL.
1018
1019   SUB-LEVEL subexpression match; default is 0.
1020
1021   VERB      verbose messages.
1022
1023 Example:
1024
1025   Myfile.sh   #comment
1026
1027   com-re     = '.*\\\\(#\\\\)'
1028   sub-level  = 1 , because there is paren"
1029   (let* ((err-col       tinydesk-:message-column)
1030          (file-face     (tinydesk-face 'file-pick))
1031          (sub-level     (or sub-level 0))
1032          (c-chars       tinydesk-:comment-characters)
1033          (comment       (tinydesk-comment))
1034          bp ep                          ;beg, end points
1035          elp                            ;end line point
1036          maxlp                          ;max line point
1037          file)
1038     (and verb                           ;this make take a while...
1039          (message "TinyDesk: Marking files..."))
1040     (save-restriction
1041       (narrow-to-region beg end)
1042       (goto-char (point-min))
1043       (while (not (eobp))
1044         (if (looking-at  "^[ \t]*$\\|$")
1045             nil                         ;ignore empty lines
1046           (setq elp (line-end-position))
1047           (setq maxlp elp)
1048           ;;  Does there exist comment on the line ?
1049           (save-excursion
1050             (when (and (stringp com-re)
1051                        (looking-at com-re))
1052               (setq maxlp (1- (match-beginning sub-level)))))
1053           (if (< maxlp (1+ (point)))    ;beg of line COMMENT exist
1054               (progn
1055 ;;;             (ti::d! "skipped" (ti::read-current-line))
1056                 nil)
1057             (skip-syntax-forward " " maxlp) ;ignore whitespace
1058             (setq bp (point))
1059
1060             (skip-chars-forward "^ \t"  maxlp) ;first space
1061             (if (eq bp ep)             ;not moved, maybe "one-word$" ?
1062                 (goto-char maxlp))
1063             (setq ep (point))
1064             (if (eq bp ep)
1065                 nil                     ;still not moved ?
1066               ;;  Mark the word only if the WORD is valid file
1067               ;;  - If the filename has ange-ftp @ char, then mark
1068               ;;    automatically. Calling file-exists-p for ange
1069               ;;    file would start ange-ftp... and we don't
1070               ;;    want that here.
1071               (setq file (buffer-substring bp ep))
1072               (setq file (tinydesk-file-name-absolute file))
1073 ;;;           (ti::d! bp ep (point) file )
1074               (goto-char ep)
1075               (if (looking-at "[ \t;]")
1076                   (delete-region (point) elp)) ;delete other marks
1077               (cond
1078                ((get-file-buffer file)  ;already in Emacs ?
1079                 (move-to-column err-col t)
1080                 (if (not (looking-at (concat "$\\|[ \t" c-chars "]")))
1081                     (end-of-line)) ;no other choices, place is cccupied
1082                 (insert (concat comment " loaded")))
1083                (t
1084                 ;; ............................... not loaded in Emacs ...
1085                 (if (or (string-match "@" file)
1086                         (file-exists-p file))
1087                     (put-text-property bp ep 'mouse-face file-face)))))))
1088         (forward-line 1))
1089       (set-buffer-modified-p nil)
1090       (and verb                         ;this make take a while...
1091            (message "TinyDesk: Marking files...ok")))))
1092
1093 ;;}}}
1094 ;;{{{ code: mouse
1095
1096 ;;; ........................................................... &mouse ...
1097
1098 ;;; ----------------------------------------------------------------------
1099 ;;;
1100 (defun tinydesk-mouse-load-file (event)
1101   "Load file under mouse. Use mouse EVENT."
1102   (interactive "e")
1103   (mouse-set-point event)               ;move point there
1104   (tinydesk-load-file))
1105
1106 ;;; ----------------------------------------------------------------------
1107 ;;;
1108 (defun tinydesk-remove-file-coments  ()
1109   "Remove all comment at `tinydesk-:message-column'."
1110   (interactive)
1111   (ti::save-line-column-macro nil nil
1112     (ti::pmin)
1113     (while (re-search-forward (tinydesk-comment) nil t)
1114       (if (eq (current-column) (+ 2 tinydesk-:message-column))
1115           (delete-region (- (point) 2) (line-end-position))))))
1116
1117 ;;; ----------------------------------------------------------------------
1118 ;;;
1119 (defun tinydesk-expunge-unloaded  ()
1120   "Remove lines that have 'unloaded' flag."
1121   (interactive)
1122   (ti::save-line-column-macro nil nil
1123     (ti::pmin)
1124     (while (re-search-forward (format "%s unloaded$" (tinydesk-comment)) nil t)
1125       (ti::buffer-kill-line))))
1126
1127 ;;; ----------------------------------------------------------------------
1128 ;;;
1129 (defun tinydesk-unload-current-file  ()
1130   "Remove file on this line from Emacs."
1131   (interactive)
1132   (let* ((file (tinydesk-file-name-absolute
1133                 (tinydesk-read-word)))
1134          buffer)
1135     (when file
1136       (if (setq buffer (find-buffer-visiting (expand-file-name file)))
1137           (kill-buffer buffer)
1138         (message "TinyDesk: No such buffer."))
1139       (beginning-of-line)
1140       (or (and (re-search-forward (tinydesk-comment) nil t)
1141                (progn (delete-region (point) (line-end-position)) t))
1142           (and (move-to-column tinydesk-:message-column t)
1143                (insert ";;")))
1144
1145       (insert " unloaded")
1146       (forward-line 1))))
1147
1148 ;;; ----------------------------------------------------------------------
1149 ;;;
1150 (defun tinydesk-load-file ()
1151   "Load file under point."
1152   (interactive)
1153   (let* (prop
1154          word)
1155     (setq prop (get-text-property (point) 'mouse-face))
1156     (cond
1157      (prop                              ;property found?
1158       (setq word  (tinydesk-file-name-absolute
1159                    (tinydesk-read-word))) ;read word under cursor
1160       (cond
1161        (word                            ;grabbed
1162         (tinydesk-handle-text-property prop word))))
1163      ((interactive-p)
1164       (message
1165        (substitute-command-keys
1166         (concat
1167          "TinyDesk: Can't find mouse face...   Mark buffer first with "
1168          "\\[tinydesk-mark-buffer-loadable]")))))))
1169 ;;}}}
1170 ;;{{{ code: edit, unload
1171
1172 ;;; ----------------------------------------------------------------------
1173 ;;;
1174 ;;;###autolaod
1175 (defun tinydesk-unload (file &optional verb)
1176   "Unload all files from Emacs that are in state file FILE.
1177
1178 If VERB is non-nil offer verbose messages [for code calls]; interactive
1179 call always turns on verbose."
1180
1181   (interactive
1182    (list
1183     (let* ((save-dir    (or (tinydesk-get-save-dir) "~/"))
1184            (msg         (concat "Unload from state file: ")))
1185       (read-file-name msg  save-dir))))
1186   (let* ((b      (tinydesk-tmp-buffer))
1187          (dlist  (tinydesk-dired-table))
1188          (count  0)
1189          (total  0)
1190          buffer
1191          elt
1192          fn)
1193     (ti::verb)
1194     (with-current-buffer b
1195       (erase-buffer)
1196       (insert-file-contents file)
1197       ;;  - Now process every line. We don't care if we read commented
1198       ;;    line as "buffer" because the test inside loop return nil
1199       ;;    for such lines...
1200       (ti::pmin)
1201       (if (eobp)
1202           (if verb
1203               (message "TinyDesk: Empty state file."))
1204         (while (not (eobp))
1205           (beginning-of-line)
1206           ;;  - Expect Win32 or Unix absolute path name in line
1207           ;;  - find-buffer-visiting function can find files that
1208           ;;    may be symlinks.
1209
1210           (when (and (looking-at "[a-zA-Z]:/[^ \t\n\r]+\\|[~/][^ \t\n\r]+")
1211                      (setq fn (match-string 0))
1212                      (or (and (file-directory-p fn)
1213                               (setq elt (assoc (expand-file-name fn) dlist))
1214                               (setq buffer (nth 1 elt)))
1215                          (setq buffer (find-buffer-visiting fn))))
1216             (with-current-buffer buffer
1217               (cond
1218                ((not (buffer-modified-p))
1219                 (kill-buffer (current-buffer))
1220                 (incf count))
1221                (t
1222                 (message "Tinydesk: Buffer %s modified. Won't unload."
1223                          (buffer-name)))))
1224             (incf  total))
1225           (forward-line))))
1226     (when verb
1227       (if (> count 0)
1228           (message (format "TinyDesk: Removed %d/%d files. %s"
1229                            count
1230                            total
1231                            (if (equal count total)
1232                                ""
1233                              " Modified buffer not unloaded.")))
1234         (message "TinyDesk: No files removed.")))
1235     (tinydesk-trash)))
1236
1237 ;;; ----------------------------------------------------------------------
1238 ;;;
1239 ;;;###autolaod
1240 (defun tinydesk-mode (&optional no-face verb)
1241   "Mark and parse buffer's fist words as loada files.
1242 If NO-FACE is non-nil, the default mouse marking isn't performed. VERB.
1243
1244 Comments in the right tell what is the files status:
1245 loaded      = file inside Emacs already
1246 invalid     = the path is invalid, no such file exists
1247
1248 Mode description:
1249
1250 \\{tinydesk-mode-map}"
1251   (interactive "P")
1252   (ti::verb)
1253   ;; - If the file is already in buffer, remove extra marks, like
1254   ;;   non-loadable files.
1255   (tinydesk-clear-region-properties (point-min) (point-max))
1256   (tinydesk-remove-file-coments)
1257   (if (null no-face)
1258       (tinydesk-mark-buffer-loadable verb))
1259   (tinydesk-mode-map-activate)          ;turn on the map
1260   (setq  mode-name   tinydesk-:mode-name)
1261   (setq  major-mode 'tinydesk-mode) ;; for C-h m
1262   (when verb
1263     (message
1264      (substitute-command-keys
1265       (concat
1266        "load \\[tinydesk-load-file] "
1267        "clear \\[tinydesk-clear-buffer-properties] "
1268        "error \\[tinydesk-set-face-non-files-buffer] "
1269        "mark \\[tinydesk-mark-buffer-loadable]")))
1270     (sleep-for 1))
1271   (run-hooks 'tinydesk-:mode-hook))
1272
1273 ;;; ----------------------------------------------------------------------
1274 ;;;
1275 (defun turn-on-tinydesk-mode ()
1276   "Turn on `tinydesk-mode'."
1277   (interactive)
1278   (tinydesk-mode))
1279
1280 ;;; ----------------------------------------------------------------------
1281 ;;;
1282 (defun turn-on-tinydesk-mode-maybe ()
1283   "Turn on `tinydesk-mode' if `tinydesk-:save-title' is found."
1284   (interactive)
1285   (let* ((string (substring
1286                   (or (eval tinydesk-:save-title)
1287                       "####No-string-available###")
1288                   0 40)))
1289     (save-excursion
1290       (ti::pmin)
1291       (when (re-search-forward
1292              (concat "^" (regexp-quote string)) nil 'noerr)
1293         (turn-on-tinydesk-mode)))))
1294
1295 ;;; ----------------------------------------------------------------------
1296 ;;;
1297 (defun turn-off-tinydesk-mode ()
1298   "Turn off `tinydesk-mode'."
1299   (interactive)
1300   (if (functionp default-major-mode)
1301       (funcall default-major-mode)
1302     (fundamental-mode)))
1303
1304 ;;; ----------------------------------------------------------------------
1305 ;;;
1306 ;;;###autolaod
1307 (defun tinydesk-edit-state-file (file)
1308   "Load state FILE into buffer for editing.
1309 You can add comments and remove/add files. Turns on `tinydesk-mode'.
1310
1311 Following commands are available in `tinydesk-mode'.
1312 \\{tinydesk-mode-map}"
1313   ;;  I can't use interactive "f" , beacuse I want the completions
1314   ;;  to come from the save-directory. The "f" uses by default the
1315   ;;  variable default-directory...
1316   (interactive
1317    (list
1318     (let* ((save-dir    (tinydesk-get-save-dir))
1319            (save-dir    (if save-dir
1320                             save-dir
1321                           "./"))
1322            (msg (concat "Edit state file: ")))
1323       (read-file-name msg  save-dir))))
1324   ;; If file is already loaded, avoid creating duplicate window
1325   (pop-to-buffer (find-file-noselect file))
1326   (tinydesk-mode nil t))
1327
1328 ;;}}}
1329 ;;{{{ code: save
1330
1331 ;;; ............................................................ &save ...
1332
1333 ;;; ----------------------------------------------------------------------
1334 ;;;
1335 (defun tinydesk-get-save-files (&optional dirs)
1336   "Return list of files to save, optionally DIRS too."
1337   (let ( ;;  See function tinydesk-dired-table for explanation
1338         (sym  'dired-directory)
1339         tmp
1340         list)
1341     (dolist (elt (buffer-list))
1342       (with-current-buffer elt
1343         (cond
1344          ((and dirs
1345                (eq major-mode 'dired-mode))
1346           (push (symbol-value sym) list))
1347          ((setq tmp (buffer-file-name))
1348           (push tmp list)))))
1349     list))
1350
1351 ;;; ----------------------------------------------------------------------
1352 ;;;
1353 ;;;###autolaod
1354 (defun tinydesk-save-state (file &optional mode files verb)
1355   "Output all files in Emacs into FILE.
1356 Notice, that this concerns only buffers with filenames.
1357
1358 Input:
1359
1360   FILE          the STATE file being saved
1361
1362   MODE          Control what is saved:
1363                  nil    only filenames
1364                  '(4)   \\[universal-argument], filenames and directories.
1365                  '(16)  \\[universal-argument] \\[universal-argument], Use absolute paths to HOME.
1366
1367   FILES         filenames , absolute ones. If nil then
1368                 `tinydesk-:get-save-file-function' is run to get files.
1369   VERB          verbose flag"
1370   (interactive
1371    (list (read-file-name "Save state to: " (tinydesk-get-save-dir))
1372          current-prefix-arg))
1373   (let* ((tmp-buffer    (tinydesk-tmp-buffer 'clear))
1374          (save-func     tinydesk-:get-save-file-function)
1375          (sort          tinydesk-:save-and-sort)
1376          (title         tinydesk-:save-title)
1377          (re-no         tinydesk-:save-exclude-regexp)
1378          (absolute-p   (equal mode '(16)))
1379          buffer)
1380     (ti::verb)
1381     (setq tinydesk-:directory-last (file-name-directory file))
1382     ;;  #todo: Kill buffer if it is not modified and reload it
1383     ;;  after save
1384     (when (setq buffer (get-file-buffer file))
1385       (pop-to-buffer buffer)
1386       (error "\
1387 TinyDesk: State saving aborted. Please save to new file or kill buffer: %s" file ))
1388     (run-hooks 'tinydesk-:save-before-hook)
1389     (or files
1390         (setq files (and (fboundp save-func)
1391                          (funcall save-func mode))))
1392     (if (null files)
1393         (if verb                        ;no files
1394             (message "TinyDesk: no files to save"))
1395       ;; ... ... ... ... ... ... ... ... ... ... ... ... ... . do save . .
1396       (if (or  (null file)
1397                (and (file-exists-p file)
1398                     (null (file-name-directory file))))
1399           (error (format  "TinyDesk: access problem with: '%s'" file)))
1400       ;;  We kill this buffer later, so we don't need save-excursion
1401       (set-buffer tmp-buffer)
1402       ;; ... ... ... ... ... ... ... ... ... ... ... ...  insert files . .
1403       (dolist (elt files)
1404         ;;  Remove some files...
1405         (if (or (not (stringp re-no))
1406                 (and (stringp re-no)
1407                      (not
1408                       (ti::string-match-case re-no elt))))
1409             ;;  win32 needs complete path name, not just ~/path/...
1410             (insert
1411              (if absolute-p
1412                  ;;  Don't try to expand ange-ftp filenames. It would
1413                  ;;  cause a ftp connections to be opened and that's slow....
1414                  (unless (ti::file-name-remote-p elt)
1415                    (expand-file-name elt))
1416                (abbreviate-file-name elt))
1417              "\n")))
1418       ;; ... ... ... ... ... ... ... ... ... ... ... ... ... ...  sort . .
1419       (if sort
1420           (sort-lines nil (point-min) (point-max)))
1421       ;; ... ... ... ... ... ... ... ... ... ... ... ... ... ... title . .
1422       (when title
1423         (ti::pmin)
1424         (insert (eval title)))
1425       (run-hooks 'tinydesk-:save-after-hook)
1426       (write-region (point-min) (point-max) file)
1427       (not-modified) (message "")
1428       (kill-buffer tmp-buffer)
1429       (if (interactive-p)
1430           (message (concat "TinyDesk: State saved to file " file)))
1431       ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ catch ^^^
1432       nil)
1433     (tinydesk-trash)))
1434
1435 ;;}}}
1436 ;;{{{ code: recover
1437
1438 ;;; ----------------------------------------------------------------------
1439 ;;;
1440 (defun tinydesk-rename-buffer-maybe ()
1441   "Rename buffer it FILENAME-DIR if there is <N> in the buffer name.
1442 If two or more of the files are loaded into emacs with the same name
1443 from different directories:
1444
1445   ~/tmp/file.txt         => buffer file.txt
1446   ~/txt/file.txt         => buffer file.txt<1>
1447   ~/abc/file.txt         => buffer file.txt<2>
1448   ..
1449
1450 This function will change the buffer names to include previous
1451 directory part, instead of the <N>, so that the names would read:
1452
1453   file.txt
1454   file.txt-txt
1455   file.txt-abc"
1456   (interactive)
1457   (when (and (string-match "<[0-9]+>$" (buffer-name))
1458              (buffer-file-name))
1459     (let* ((dir  (file-name-directory    (buffer-file-name)))
1460            (file (file-name-nondirectory (buffer-file-name)))
1461            (dir1 (replace-regexp-in-string
1462                   "/" "-"
1463                   (or (ti::string-match
1464                        (concat
1465                         ;;  Get Two levels up
1466                         ".*\\([\\/][^\\/]+[\\/][^\\/]+\\)\\|"
1467                         ;;  Or one level if only one directory
1468                         ".*\\([\\/][^\\/]+\\)")
1469                        1
1470                        dir)
1471                       ""))))
1472       (rename-buffer (format "%s-%s" file dir1)))))
1473
1474 ;;; ----------------------------------------------------------------------
1475 ;;;
1476 (defun tinydesk-find-file (file)
1477   "Load FILE or `recover-file' as needed. Rename buffer if buffer<2>"
1478   (with-current-buffer (find-file-noselect file)
1479     (when (and (null (buffer-modified-p))
1480                (file-exists-p (make-auto-save-file-name)))
1481       ;; Can't use (recover-file file), because it asks confirmation.
1482       ;; Emacs should have flag for suppressing questions.
1483       (erase-buffer)
1484       (insert-file-contents-literally (make-auto-save-file-name))
1485       (set-buffer-modified-p t)         ;Not strictly needed...
1486       (message "TinyDesk: Recovered file %s"
1487                (make-auto-save-file-name))
1488       (tinydesk-rename-buffer-maybe)
1489       ;;  Return value
1490       (current-buffer))))
1491
1492 ;;; ----------------------------------------------------------------------
1493 ;;;
1494 ;;;###autolaod
1495 (defun tinydesk-recover-state (file &optional ulp pop verb)
1496   "Load all files listed in FILE into Emacs.
1497 FILE can have empty lines or comments. No spaces allowed at the
1498 beginning of filename. The state FILE itself is not left inside
1499 Emacs if everything loads well. When all files are already
1500 in Emacs, you may see message '0 files loaded'.
1501
1502 In case there were problems, the FILE will be shown and the
1503 problematic lines are highlighted.
1504
1505 Prefix arg sets flag ULP, unload previous.
1506
1507 Input:
1508
1509   FILE          state file to load
1510
1511   ULP           'unload previous' if non-nil then unload previously
1512                 loaded files according to `tinydesk-:last-state-file'
1513
1514   POP           if non-nil, then show (pop to) first buffer in saved
1515                 state file. This flag is set to t in interactive calls.
1516
1517   VERB          non-nil enables verbose messages. This flag is set to
1518                 t in interactive calls.
1519
1520 References:
1521
1522   `tinydesk-:last-state-file'       Name of state file that was loaded.
1523   `tinydesk-:recover-before-hook'   Hook to run before state file processing.
1524   `tinydesk-:recover-after-hook'    Hook to run after state file processing."
1525   (interactive
1526    (list
1527     (read-file-name "Tinydesk: load state file: "
1528                     (tinydesk-get-save-dir))
1529     current-prefix-arg
1530     t))
1531   (let* ((count         0)
1532          (state-file    (expand-file-name file))
1533          (last-state    tinydesk-:last-state-file)
1534          buffer
1535          kill-buffer
1536          err
1537          not-loaded
1538          ;; first-entry
1539          list)
1540     (ti::verb)
1541     ;; o  read the config file
1542     ;; o  raise the kill flag if the file ISN'T already loaded, user
1543     ;;    may be editing it.
1544     ;; o  There may be buffers with the same name, but different dirs..
1545     (unless (setq buffer (get-file-buffer state-file))
1546       (setq kill-buffer t)              ;different directory
1547       (unless (file-exists-p state-file)
1548         (error "TinyDesk: file does not exist %s" state-file))
1549       (setq buffer (find-file-noselect state-file)))
1550     ;; ... ... ... ... ... ... ... ... ... ... ... ... unload previous ...
1551     (if (and ulp (stringp last-state))
1552         (if (not (file-exists-p last-state))
1553             (message
1554              (format "TinyDesk: Cannot unload, file does not exist '%s' "
1555                      last-state))
1556           (tinydesk-unload last-state)))
1557     (with-current-buffer (ti::temp-buffer buffer)
1558       (setq  list           (tinydesk-find-file-whole-buffer) ;; before hook
1559              count          (nth 0 list)
1560              err            (nth 1 list)
1561              ;; first-entry    (nth 3 list)
1562              not-loaded     (nth 2 list))
1563       (cond
1564        ((null err)
1565         (if verb (message (format "TinyDesk: %d files loaded" count)))
1566         (run-hooks 'tinydesk-:recover-after-hook)
1567         ;;  kill the buffer only if it was loaded by us
1568         (and kill-buffer
1569              (kill-buffer buffer)))
1570        (t
1571         ;;  Show failed files
1572         (message (concat "TinyDesk: Not loaded> " not-loaded))
1573         (sleep-for 0)
1574         (pop-to-buffer buffer)
1575         (tinydesk-mode 'no-face 'verbosee)
1576         (tinydesk-set-face-non-files-buffer)
1577         (ti::pmin)))
1578       (setq tinydesk-:last-state-file file))))
1579
1580 ;;; ----------------------------------------------------------------------
1581 ;;;
1582 ;;;###autolaod
1583 (defun tinydesk-recover-last-state ()
1584   "If Emacs was closed / crashed, recover last saved session.
1585 References:
1586   `tinydesk-:auto-save-interval'
1587   `tinydesk-:auto-save-name-function'"
1588   (let ((file (tinydesk-auto-save-file-name)))
1589     (if file
1590         (tinydesk-recover-state file)
1591       (message (concat
1592                 "TinyDesk: [WARN] Couldn't recover *last* state file."
1593                 "function `tinydesk-auto-save-file-name' returned nil")))))
1594
1595 ;;; ----------------------------------------------------------------------
1596 ;;;
1597 (defun tinydesk-recover-file-whole-buffer (&optional verb)
1598   "Call `tinydesk-find-file' with argument `recover'. VERB."
1599   (interactive)
1600   (save-excursion
1601     (tinydesk-find-file-whole-buffer 'recover (ti::verb))))
1602
1603 ;;; ----------------------------------------------------------------------
1604 ;;;
1605 (defun tinydesk-find-file-whole-buffer (&optional recover verb)
1606   "Load all files listed in buffer. Point is not preserved.
1607
1608 Input:
1609
1610   RECOVER   Flag. If non-nil, use `recover-file' instead of `find-file'.
1611   VERB      Verbose flag.
1612
1613 References:
1614
1615   `tinydesk-:loaded-file-list'
1616   `tinydesk-:rejected-file-list'
1617   `tinydesk-:recover-before-hook'   Hook to run before state file processing.
1618
1619 Return:
1620
1621    '(count err not-loaded-string first-entry)
1622
1623    count                how many files actually loaded
1624    err                  error while load
1625    not-loaded-string    files that had problems.
1626    first-entry          first entry"
1627   (interactive "P")
1628   (let* ((count         0)
1629          (sub-level     tinydesk-:comment-start-level)
1630          (ignore-re     (tinydesk-comment-re))
1631          (empty-re      "^[ \t]*$")
1632          (msg-str       (if recover
1633                             "Recovering"
1634                           "Loading"))
1635          first-entry
1636          bp
1637          not-loaded
1638          load                       ;file ont the line to be processed
1639          maxp                           ;max point
1640          word
1641          err                            ;per file basis
1642          ERR)                           ;return status
1643     (ti::verb)
1644     (setq   tinydesk-:loaded-file-list   nil ;<< reset GLOBALS
1645             tinydesk-:rejected-file-list        nil)
1646     (run-hooks 'tinydesk-:recover-before-hook)
1647     (ti::pmin)                          ;there is *no* save excursion
1648     (while (not (eobp))
1649       (setq bp (point)  err nil)        ;BEG of line
1650       (setq maxp (line-end-position))
1651       (beginning-of-line)
1652       (catch 'next
1653         ;; ... ... ... ... ... ... ... ... ... ... ... ... .. comments ...
1654         (if (looking-at empty-re)       ;emty lines
1655             (throw 'next t))
1656         (when (and (looking-at ignore-re)
1657                    (match-beginning sub-level))
1658           (setq maxp  (match-beginning sub-level)))
1659         (if (eq maxp bp)                ;full comment line ?
1660             (throw 'next t))
1661         ;; ... ... ... ... ... ... ... ... ... ... ...  read file name ...
1662         ;;  Now load the file, raise error if not loaded
1663         ;;  Remember that Windows fiels may contain spaces c:\Program Files\
1664         (setq word (tinydesk-read-word))
1665         ;; --``-- --``-- --``-- --``-- --``-- --``-- --``-- --``-- --``--
1666         (when word
1667           (setq load (expand-file-name word))
1668 ;;;       (ti::d! "buffer?" (get-file-buffer load) (ti::file-find-file-p load) load)
1669           (when (or recover
1670                     (or load            ;file grabbed from line
1671                         (not (get-file-buffer load)))) ;already in Emacs
1672             (if (not (ti::file-find-file-p load))
1673                 (setq err t)
1674               (when (condition-case nil
1675                         (progn
1676                           (if verb
1677                               (message "TinyDesk: %s %s..." msg-str load))
1678                           (tinydesk-find-file load)
1679                           t)
1680                       (error
1681                        (setq err t)
1682                        nil))
1683                 (setq count (1+ count))
1684                 (if (null first-entry)
1685                     (setq first-entry word))
1686                 (ti::nconc tinydesk-:loaded-file-list word)))))
1687         ;; --``-- --``-- --``-- --``-- --``-- --``-- --``-- --``-- --``--
1688         (when err
1689           (setq ERR t)
1690           (push word tinydesk-:rejected-file-list)
1691           (and (interactive-p)
1692                (tinydesk-line-property-set-error))
1693           (setq  not-loaded
1694                  (concat
1695                   (or not-loaded "")    ;start value
1696                   (or
1697                    (file-name-nondirectory load)
1698                    "[nil-word]")
1699                   " "))))               ;catch line
1700       (forward-line 1))
1701     (if verb
1702         (message "TinyDesk: %s...done" msg-str))
1703 ;;;    (ti::d! "load-end" count ERR not-loaded)
1704     (list count ERR not-loaded first-entry)))
1705
1706 ;;}}}
1707
1708 ;;; ----------------------------------------------------------------------
1709 ;;;
1710 (defun tinydesk-install (&optional uninstall)
1711   "Install or UNINSTALL package."
1712   (interactive "p")
1713   (unless tinydesk-mode-map
1714     (setq tinydesk-mode-map (make-sparse-keymap))
1715     (run-hooks 'tinydesk-:mode-define-keys-hook))
1716   (cond
1717    (uninstall
1718     (remove-hook 'write-file-hooks 'tinydesk-auto-save)
1719     (remove-hook 'find-file-hooks  'turn-on-tinydesk-mode-maybe))
1720    (t
1721     (add-hook 'write-file-hooks 'tinydesk-auto-save)
1722     (add-hook 'find-file-hooks  'turn-on-tinydesk-mode-maybe))))
1723
1724 (tinydesk-install)
1725
1726 (provide   'tinydesk)
1727 (run-hooks 'tinydesk-:load-hook)
1728
1729 ;;; tinydesk.el ends here