~ubuntu-branches/ubuntu/gutsy/howm/gutsy : revision 1

1

;;; howm-mode.el --- Wiki-like note-taking tool

2

3

;;; by HIRAOKA Kazuyuki <khi@users.sourceforge.jp>

4

;;; $Id: howm-mode.el,v 1.285 2005/11/04 13:04:33 hira Exp $

5

;;;

6

;;; This program is free software; you can redistribute it and/or modify

7

;;; it under the terms of the GNU General Public License as published by

8

;;; the Free Software Foundation; either version 1, or (at your option)

9

;;; any later version.

10

;;;

11

;;; This program is distributed in the hope that it will be useful,

12

;;; but WITHOUT ANY WARRANTY; without even the implied warranty of

13

;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

14

;;; GNU General Public License for more details.

15

;;;

16

;;; The GNU General Public License is available by anonymouse ftp from

17

;;; prep.ai.mit.edu in pub/gnu/COPYING. Alternately, you can write to

18

;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139,

19

;;; USA.

20

;;;--------------------------------------------------------------------

21

22

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

23

;; Backward compatibility

24

25

;; (require 'howm-mode) in .emacs is obsolete. Use (require 'howm) instead.

26

27

;; This must be earlier than (require 'howm-common), because

28

;; howm-common needs cl, and (require 'cl) should be written in howm.el.

29

(when (not (featurep 'howm-version))

30

(message "Warning: Requiring howm-mode is obsolete. Require howm instead.")

31

;; (beep)

32

;; (sit-for 1)

33

(require 'howm))

34

35

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

36

;; Require

37

38

(require 'howm-common)

39

40

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

41

;; Customize

42

43

;;; --- level 1 ---

44

45

;; You can easily modify them.

46

47

(defvar howm-template

48

(concat howm-view-title-header " %title%cursor\n%date %file\n\n")

49

"Contents of new file. %xxx are replaced with specified items.

50

If it is a list, <n>-th one is used when you type C-u <n> M-x howm-create.

51

If it is a function, it is called to get template string with the argument <n>.")

52

(defvar howm-keyword-header "<<<"

53

"Header string for declaration of keyword (implicit link).")

54

(defvar howm-ref-header ">>>"

55

"Header string for explicit link.")

56

(defvar howm-lighter " howm"

57

"Mode line for howm-mode")

58

59

(defvar howm-inhibit-title-file-match t

60

"If non-nil, inhibit howm-list-title when search string matches file name")

61

(defvar howm-list-all-title nil) ;; obsolete [2003-11-30]

62

(defvar howm-list-recent-title nil) ;; obsolete [2003-11-30]

63

(defvar howm-date-separator "-") ;; "-" ==> 2003-10-21

64

65

(defvar howm-default-key-table

66

'(

67

;; ("key" func list-mode-p global-p)

68

("r" howm-refresh)

69

("l" howm-list-recent t t)

70

("a" howm-list-all t t)

71

("g" howm-list-grep t t)

72

("s" howm-list-grep-fixed t t)

73

("m" howm-list-migemo t t)

74

("t" howm-list-todo t t)

75

("y" howm-list-schedule t t)

76

("c" howm-create t t)

77

("," howm-menu t t)

78

("." howm-find-today nil t)

79

(":" howm-find-yesterday nil t)

80

("A" howm-list-around)

81

("h" howm-history nil t)

82

("D" howm-dup)

83

("i" howm-insert-keyword nil t)

84

("d" howm-insert-date nil t)

85

("T" howm-insert-dtime nil t)

86

("K" howm-keyword-to-kill-ring t t)

87

("n" action-lock-goto-next-link)

88

("p" action-lock-goto-previous-link)

89

("Q" howm-kill-all t t)

90

(" " howm-toggle-buffer nil t)

91

("N" howm-next-memo)

92

("P" howm-previous-memo)

93

("H" howm-first-memo)

94

("L" howm-last-memo)

95

("C" howm-create-here nil t)

96

("I" howm-create-interactively nil t)

97

("w" howm-random-walk nil t)

98

)

99

"List of (key function list-mode-p).

100

`howm-prefix' + this key is real stroke.

101

If optional argument list-mode-p is non-nil,

102

same key is also available in view mode."

103

)

104

105

(defvar howm-migemo-client nil)

106

;; (defvar howm-migemo-client "migemo-client")

107

108

;;; --- level 2 ---

109

110

;; Be careful to keep consistency.

111

112

(defvar howm-keyword/ref-regexp-format "\$%s\$[ \t]*\$[^ \t\r\n].*\$")

113

(defvar howm-keyword-format (format "%s %%s" howm-keyword-header)

114

"Format for declaration of keyword. See `format'.")

115

(defvar howm-keyword-regexp (format howm-keyword/ref-regexp-format

116

(regexp-quote howm-keyword-header)))

117

(defvar howm-keyword-regexp-hilit-pos 1)

118

(defvar howm-keyword-regexp-pos 2)

119

(defvar howm-ref-regexp (format howm-keyword/ref-regexp-format

120

(regexp-quote howm-ref-header))

121

"Regexp for explicit link.")

122

(defvar howm-ref-regexp-hilit-pos 0

123

"Position of search string in `howm-ref-regexp'")

124

(defvar howm-ref-regexp-pos 2

125

"Position of search string in `howm-ref-regexp'")

126

(defvar howm-wiki-regexp "\\[\\[\$[^]\r\n]+\$\\]\\]"

127

"Regexp for explicit link.")

128

(defvar howm-wiki-regexp-hilit-pos 1

129

"Position of hilight in `howm-wiki-regexp'")

130

(defvar howm-wiki-regexp-pos 1

131

"Position of search string in `howm-wiki-regexp'")

132

(defvar howm-wiki-format "[[%s]]"

133

"Format for declaration of wiki word. See `format'.")

134

;; (defvar howm-wiki-regexp "\\[\\[\$[^]\r\n]+\$\$\\]\\]\$"

135

;; "Regexp for explicit link.")

136

;; (defvar howm-wiki-regexp-hilit-pos 2

137

;; "Position of search string in `howm-wiki-regexp'")

138

;; (defvar howm-wiki-regexp-pos 1

139

;; "Position of search string in `howm-wiki-regexp'")

140

141

;; Fix me: redundant (howm-date-* & howm-reminder-*)

142

(defvar howm-date-regexp-grep

143

(concat "[1-2][0-9][0-9][0-9]" howm-date-separator

144

"[0-1][0-9]" howm-date-separator

145

"[0-3][0-9]"))

146

(defvar howm-date-regexp

147

(concat "\$[1-2][0-9][0-9][0-9]\$" howm-date-separator

148

"\$[0-1][0-9]\$" howm-date-separator

149

"\$[0-3][0-9]\$"))

150

(defvar howm-date-regexp-year-pos 1)

151

(defvar howm-date-regexp-month-pos 2)

152

(defvar howm-date-regexp-day-pos 3)

153

(defvar howm-date-format

154

(concat "%Y" howm-date-separator "%m" howm-date-separator "%d"))

155

(defvar howm-dtime-body-format

156

(concat howm-date-format " %H:%M"))

157

(defvar howm-dtime-format

158

(concat "[" howm-dtime-body-format "]"))

159

(defvar howm-insert-date-format "[%s]")

160

(defvar howm-insert-date-future nil)

161

162

(defvar howm-template-rules

163

'(("%title" . howm-template-title)

164

("%date" . howm-template-date)

165

("%file" . howm-template-previous-file)

166

("%cursor" . howm-template-cursor))) ;; Cursor must be the last rule.

167

(defvar howm-template-date-format howm-dtime-format

168

"%date is replaced with `howm-template-date-format'

169

in `howm-template'. See `format-time-string'")

170

(defvar howm-template-file-format (concat howm-ref-header " %s")

171

"%file is replaced with `homw-template-file-format'

172

in `howm-template'. %s is replaced with name of last file. See `format'.")

173

174

;;; --- level 3 ---

175

176

;; As you like.

177

178

(defun howm-action-lock-general (command regexp pos

179

&optional hilit-pos

180

&rest options)

181

(list regexp

182

`(lambda (&optional dummy)

183

(let ((s (match-string-no-properties ,pos)))

184

;; (when howm-keyword-case-fold-search

185

;; (setq s (downcase s)))

186

(,command s ,@options)))

187

(or hilit-pos 0)

188

t))

189

190

(defun howm-action-lock-search (regexp

191

pos

192

&optional hilit-pos create-p open-unique-p)

193

(howm-action-lock-general 'howm-keyword-search

194

regexp pos hilit-pos create-p open-unique-p))

195

(defun howm-action-lock-related (regexp pos hilit-pos)

196

(howm-action-lock-general 'howm-list-related regexp pos hilit-pos))

197

198

(defun howm-action-lock-date-rule ()

199

(action-lock-general 'howm-action-lock-date howm-date-regexp 0 0))

200

201

(defun howm-action-lock-setup ()

202

(setq action-lock-case-fold-search howm-keyword-case-fold-search)

203

(action-lock-mode t)

204

(let* ((date-al (action-lock-date "{_}" howm-dtime-format)))

205

;; override the rule in action-lock.el

206

(action-lock-add-rules (list date-al) t))

207

(let* ((ks (howm-keyword-for-goto))

208

(r (mapconcat 'regexp-quote ks "\\|"))

209

(wiki (howm-action-lock-search howm-wiki-regexp

210

howm-wiki-regexp-pos

211

howm-wiki-regexp-hilit-pos

212

t

213

))

214

;; (explicit (howm-action-lock-goto howm-ref-regexp

215

(explicit (howm-action-lock-search howm-ref-regexp

216

howm-ref-regexp-pos

217

howm-ref-regexp-hilit-pos

218

))

219

(implicit (howm-action-lock-search r 0))

220

(rev (howm-action-lock-related howm-keyword-regexp

221

howm-keyword-regexp-pos

222

howm-keyword-regexp-hilit-pos))

223

(date (howm-action-lock-date-rule))

224

(done (howm-action-lock-reminder-done-rule))

225

(all `(

226

,explicit

227

,rev

228

,@(if ks (list implicit) nil)

229

,wiki

230

,@(if (howm-menu-p) nil (list date done))

231

))

232

)

233

;; don't override the rule in action-lock.el

234

;; esp. http://xxx should call browser even if "<<< http" exists

235

(action-lock-add-rules all)))

236

237

(defun howm-file-name (&optional time)

238

(format-time-string howm-file-name-format

239

(or time (current-time))))

240

241

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

242

;; Definitions

243

244

(easy-mmode-define-minor-mode howm-mode

245

"With no argument, this command toggles the mode.

246

Non-null prefix argument turns on the mode.

247

Null prefix argument turns off the mode.

248

249

When the mode is enabled, underlines are drawn on texts which match

250

to titles of other files. Typing \\[action-lock-magic-return] there,

251

you can jump to the corresponding file.

252

253

key binding

254

--- -------

255

\\[action-lock-magic-return] Follow link

256

\\[howm-refresh] Refresh buffer

257

\\[howm-list-all] List all files

258

\\[howm-list-grep] Search (grep)

259

\\[howm-create] Create new file

260

\\[howm-dup] Duplicate current file

261

\\[howm-insert-keyword] Insert keyword

262

\\[howm-insert-date] Insert date

263

\\[howm-insert-dtime] Insert date with time

264

\\[howm-keyword-to-kill-ring] Copy current keyword to kill ring

265

\\[action-lock-goto-next-link] Go to next link

266

\\[action-lock-goto-previous-link] Go to previous link

267

\\[howm-next-memo] Go to next entry in current buffer

268

\\[howm-previous-memo] Go to previous entry in current buffer

269

\\[howm-first-memo] Go to first entry in current buffer

270

\\[howm-last-memo] Go to last entry in current buffer

271

\\[howm-create-here] Add new entry to current buffer

272

\\[howm-create-interactively] Create new file interactively (not recommended)

273

\\[howm-random-walk] Browse random entries automtically

274

"

275

nil ;; default = off

276

howm-lighter ;; mode-line

277

`(

278

,@(mapcar (lambda (entry)

279

(let ((k (car entry))

280

(f (second entry)))

281

(cons (concat howm-prefix k) f)))

282

howm-default-key-table)

283

))

284

285

(add-hook 'howm-mode-on-hook 'howm-initialize-buffer)

286

(add-hook 'howm-mode-off-hook 'howm-restore-buffer)

287

288

(defun howm-set-keymap ()

289

(mapc (lambda (entry)

290

(let* ((k (car entry))

291

(f (second entry))

292

(list-mode-p (third entry))

293

(global-p (fourth entry))

294

(pk (concat howm-prefix k)))

295

(define-key howm-mode-map pk f)

296

(when list-mode-p

297

(mapc (lambda (m)

298

(define-key m k f)

299

(define-key m pk f))

300

(list howm-view-summary-mode-map

301

howm-view-contents-mode-map)))

302

(when global-p

303

(define-key global-map pk f))))

304

howm-default-key-table)

305

(define-key howm-mode-map "\C-x\C-s" 'howm-save-buffer)

306

)

307

(howm-set-keymap)

308

309

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

310

;; Main functions

311

312

(defun howm-refresh ()

313

(interactive)

314

(if (howm-menu-p)

315

(howm-menu-refresh)

316

(howm-initialize-buffer)))

317

318

(defun howm-initialize-buffer ()

319

(interactive)

320

(when (not howm-mode)

321

(error "Not howm-mode"))

322

(howm-message-time "init-buf"

323

(save-restriction

324

(widen)

325

(howm-set-configuration-for-major-mode major-mode)

326

(howm-action-lock-setup)

327

(howm-mode-add-font-lock)

328

(howm-reminder-add-font-lock)

329

;; font-lock-fontify-buffer is necessary for emacs20,

330

;; while -block is necessary for emacs21.

331

;; I don't understand this. [2004-12-18]

332

(howm-fontify t)

333

;; make-local-hook is obsolete for emacs >= 21.1.

334

(make-local-hook 'after-save-hook)

335

(add-hook 'after-save-hook 'howm-after-save t t))))

336

337

(defun howm-after-save ()

338

(when howm-mode

339

(howm-keyword-add-current-buffer)

340

(when howm-refresh-after-save

341

(howm-initialize-buffer))

342

(when (and howm-menu-refresh-after-save

343

(> howm-menu-expiry-hours 0))

344

(howm-menu-refresh-background))

345

(run-hooks 'howm-after-save-hook)))

346

347

(defun howm-restore-buffer ()

348

(action-lock-mode 0))

349

350

(defun howm-list-all ()

351

(interactive)

352

(howm-set-command 'howm-list-all)

353

(howm-view-directory (car (howm-search-path)) t)

354

(howm-list-normalize)

355

;; clean me [2004-07-11]

356

(cond ((howm-list-title-p) t) ;; already done in (howm-list-normalize)

357

(howm-list-all-title (howm-list-title))))

358

359

(defun howm-list-recent (&optional days)

360

(interactive "P")

361

(howm-set-command 'howm-list-recent)

362

(let* ((d (or days howm-list-recent-days))

363

(now (current-time))

364

(from (howm-days-before now d)))

365

(howm-view-directory howm-directory t)

366

(howm-view-filter-by-mtime nil (list from now))

367

(howm-list-normalize)

368

;; clean me [2003-11-30]

369

(cond ((howm-list-title-p) t) ;; already done in (howm-list-normalize)

370

(howm-list-recent-title (howm-list-title))

371

((not days) (howm-view-summary-to-contents)))))

372

373

;; clean me: direct access to howm-view-* is undesirable.

374

375

(defvar howm-list-title-previous nil

376

"For internal use")

377

(make-variable-buffer-local 'howm-list-title-previous)

378

(defun howm-list-title-put-previous ()

379

(when howm-list-title-undo

380

(setq howm-list-title-previous (howm-view-item-list))))

381

(defun howm-list-title-get-previous ()

382

(if howm-list-title-undo

383

(let ((prev howm-list-title-previous))

384

(setq howm-list-title-previous nil)

385

(howm-view-summary-rebuild prev))

386

(error "Undo is not enabled.")))

387

(defun howm-list-title-regexp ()

388

(or howm-list-title-regexp (howm-view-title-regexp-grep)))

389

(defun howm-list-title (&optional undo)

390

(interactive "P")

391

(if (or undo howm-list-title-previous)

392

(howm-list-title-get-previous)

393

(let ((b (current-buffer)))

394

(howm-list-title-put-previous)

395

(howm-view-list-title (howm-list-title-regexp))

396

;; (howm-view-filter-by-contents (howm-list-title-regexp))

397

(let ((c (current-buffer)))

398

(when (not (eq b c))

399

(set-buffer b)

400

(howm-view-kill-buffer)

401

(switch-to-buffer c)

402

(howm-view-summary-check t))))))

403

404

(defun howm-list-title-p ()

405

(let ((a (howm-get-value howm-list-title)))

406

(cond ((null a) nil) ;; I know this is redundant.

407

((listp a) (member (howm-command) a))

408

(t a))))

409

410

(defun howm-days-after (ti days &optional hours)

411

(let* ((ne (decode-time ti))

412

(hour-pos 2)

413

(day-pos 3)

414

(nh (nth hour-pos ne))

415

(nd (nth day-pos ne)))

416

(setf (nth hour-pos ne) (+ nh (or hours 0)))

417

(setf (nth day-pos ne) (+ nd days))

418

(apply #'encode-time ne)))

419

420

(defun howm-days-before (ti days)

421

(howm-days-after ti (- days)))

422

423

(defun howm-list-grep (&optional completion-p)

424

(interactive "P")

425

(howm-set-command 'howm-list-grep)

426

(howm-list-grep-general completion-p))

427

428

(defun howm-list-grep-fixed ()

429

(interactive)

430

(howm-set-command 'howm-list-grep-fixed)

431

(howm-list-grep-general t))

432

433

(defun howm-list-grep-general (&optional completion-p)

434

(let* ((regexp (if completion-p

435

(howm-completing-read-keyword)

436

(read-from-minibuffer "Search all (grep): "))))

437

(when completion-p ;; Goto link works only for fixed string at now.

438

(howm-write-history regexp))

439

(howm-search regexp completion-p)))

440

441

(defun howm-search (regexp fixed-p &optional emacs-regexp)

442

(if (string= regexp "")

443

(howm-list-all)

444

(howm-message-time "search"

445

(prog1

446

(howm-call-view-search regexp fixed-p emacs-regexp)

447

(howm-list-normalize (or emacs-regexp regexp))))))

448

449

(defvar *howm-view-window-configuration* nil

450

"For internal use")

451

(defun howm-view-window-configuration ()

452

*howm-view-window-configuration*)

453

(defun howm-set-view-window-configuration (conf)

454

(setq *howm-view-window-configuration* conf))

455

(defun howm-record-view-window-configuration ()

456

(howm-set-view-window-configuration (current-window-configuration)))

457

(defun howm-restore-view-window-configuration ()

458

(set-window-configuration (howm-view-window-configuration)))

459

(defun howm-return-to-list ()

460

(interactive)

461

(howm-restore-view-window-configuration))

462

463

(defun howm-call-view-search (regexp fixed-p &optional emacs-regexp)

464

(let ((hilit (if emacs-regexp

465

`((,emacs-regexp . howm-view-hilit-face))

466

nil)))

467

(howm-view-search-folder regexp (howm-search-path-folder)

468

nil nil fixed-p hilit)

469

(howm-record-view-window-configuration)))

470

471

(defun howm-list-migemo (&optional completion-p)

472

(interactive "P")

473

(howm-set-command 'howm-list-migemo)

474

(if completion-p

475

(howm-list-grep t)

476

(let* ((roma (read-from-minibuffer "Search all (migemo): "))

477

(e-reg (howm-migemo-get-pattern roma "emacs"))

478

(g-reg (if howm-view-use-grep

479

(howm-migemo-get-pattern roma "egrep")

480

e-reg)))

481

(if (and e-reg g-reg)

482

(howm-search g-reg nil e-reg)

483

(message "No response from migemo-client.")))))

484

485

486

(defun howm-migemo-get-pattern (roma type)

487

(when (and (null howm-migemo-client) (not howm-view-use-grep))

488

(require 'migemo))

489

(if (and (featurep 'migemo) (string= type "emacs"))

490

(howm-funcall-if-defined (migemo-get-pattern roma))

491

;; (migemo-get-pattern roma)

492

(car (howm-call-process (or howm-migemo-client "migemo-client")

493

`("-t" ,type ,roma) 0))))

494

495

(defun howm-list-normalize (&optional keyword comefrom-regexp no-list-title)

496

"Sort displayed items in the standard order.

497

--- Sorry, below documentation is incomplete. ---

498

When KEYWORD is given, matched items are placed on the top.

499

KEYWORD can be a string or a list of strings.

500

"

501

;; (let ((*howm-view-summary-nop* t)) ;; dirty

502

(let ((matched (howm-view-in-background

503

(howm-list-normalize-subr keyword comefrom-regexp

504

no-list-title))))

505

(howm-view-summary)

506

matched))

507

508

(defun howm-list-normalize-subr (keyword comefrom-regexp no-list-title)

509

(let ((matched nil))

510

(howm-list-exclude)

511

(funcall howm-list-normalizer)

512

(when keyword

513

(let ((key-reg (or comefrom-regexp

514

(howm-make-keyword-regexp1 keyword)))

515

(word-reg (format "\\<%s\\>"

516

(if (stringp keyword)

517

(regexp-quote keyword)

518

(regexp-opt keyword t))))

519

(wiki-reg (regexp-quote (howm-make-wiki-string keyword)))

520

(file-reg (and

521

(stringp keyword)

522

(format "^%s$"

523

(regexp-quote (expand-file-name keyword)))))

524

(case-fold-search howm-keyword-case-fold-search))

525

(let ((check (lambda (tag flag reg)

526

(and flag

527

(if (eq tag 'file)

528

(howm-view-sort-by-name-match nil reg t)

529

(howm-view-sort-by-summary-match nil reg))

530

(setq matched (cons tag matched))))))

531

(funcall check 'word howm-list-prefer-word word-reg)

532

(funcall check 'wiki howm-list-prefer-wiki wiki-reg)

533

(funcall check 'related-keyword t howm-keyword-regexp)

534

(funcall check 'keyword t key-reg)

535

(funcall check 'file file-reg file-reg))))

536

(when (and (howm-list-title-p)

537

(not no-list-title)

538

(not (and (member 'file matched)

539

howm-inhibit-title-file-match)))

540

(howm-list-title))

541

matched))

542

543

(defun howm-make-keyword-string (keyword)

544

(format howm-keyword-format keyword))

545

(defun howm-make-wiki-string (keyword)

546

(format howm-wiki-format keyword))

547

548

;; clean me

549

(defvar howm-keyword-regexp-format "%s$"

550

"Format to make entire-match regexp from keyword string.

551

Default is \"%s$\" because we want to make regexp \"<<< foo$\"

552

from keyword string \"<<< foo\",

553

so that we can accept \"<<< foo\" and reject \"<<< foobar\".

554

We need entire-match in order to

555

(1) place \"<<< foo\" on the top when \"foo\" is searched, and

556

(2) judge existence of \"<<< foo\" when [[foo]] is hit.")

557

(defun howm-make-keyword-regexp1 (keyword)

558

(howm-make-keyword-regexp-general keyword #'howm-make-keyword-regexp1-sub))

559

(defun howm-make-keyword-regexp2 (keyword)

560

(howm-make-keyword-regexp-general keyword #'howm-make-keyword-regexp2-sub))

561

(defun howm-make-keyword-regexp1-sub (keyword)

562

(format howm-keyword-regexp-format

563

(regexp-quote (howm-make-keyword-string keyword))))

564

(defun howm-make-keyword-regexp2-sub (keyword)

565

(format howm-keyword-regexp-format

566

(howm-make-keyword-string (regexp-quote keyword))))

567

(defun howm-make-keyword-regexp-general (keyword regexp-generator)

568

(cond ((stringp keyword)

569

(funcall regexp-generator keyword))

570

((listp keyword)

571

(mapconcat (lambda (s)

572

(concat "\\("

573

(funcall regexp-generator s)

574

"\\)"))

575

keyword

576

"\\|"))

577

(t (error "Wrong type: %s" keyword))))

578

579

(defun howm-list-related (str)

580

(howm-set-command 'howm-list-related)

581

(let ((keys (mapcar (lambda (k)

582

(if howm-keyword-case-fold-search

583

(downcase k)

584

k))

585

(howm-subkeyword str))))

586

(howm-search (howm-make-keyword-string ".*") nil)

587

(howm-view-filter-by-summary nil (regexp-opt keys))))

588

(defun howm-subkeyword (str)

589

(with-temp-buffer

590

(insert str)

591

(howm-keyword-for-goto)))

592

593

(defun howm-list-around ()

594

(interactive)

595

(howm-set-command 'howm-list-around)

596

(let ((f (buffer-file-name)))

597

(howm-list-all)

598

(howm-view-sort-by-reverse-date)

599

(let ((pos (howm-cl-position-if (lambda (item)

600

(string= (howm-view-item-filename item)

601

f))

602

(howm-view-item-list))))

603

(goto-char (point-min))

604

(when pos

605

(forward-line pos)))

606

(howm-view-summary-check t)))

607

608

(defvar *howm-command* nil

609

"For internal use")

610

(defun howm-set-command (com)

611

(setq *howm-command* com))

612

(defun howm-command ()

613

*howm-command*)

614

615

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

616

;; Create

617

618

(defun howm-create (&optional which-template here)

619

(interactive "p")

620

(let* ((t-c (howm-create-default-title-content))

621

(title (car t-c))

622

(content (cdr t-c)))

623

(howm-create-file-with-title title which-template nil here content)))

624

625

(howm-dont-warn-free-variable transient-mark-mode)

626

(howm-dont-warn-free-variable mark-active)

627

(defun howm-create-default-title-content ()

628

(let* ((p (point))

629

(m (or (mark t) -777))

630

(beg (min p m))

631

(end (max p m))

632

(search-str (howm-view-name)))

633

(let* ((transient-mark-p (and (boundp 'transient-mark-mode)

634

transient-mark-mode))

635

(mark-active-p (and (boundp 'mark-active) mark-active))

636

(active-p (if transient-mark-p

637

mark-active-p

638

t))

639

(strictly-active-p (and transient-mark-p mark-active-p))

640

(title-p (let* ((b (line-beginning-position))

641

(e (line-end-position)))

642

(and active-p

643

(< 0 beg) (<= b beg) (<= end e) (not (= beg end)))))

644

(content-p (and strictly-active-p

645

howm-content-from-region))

646

(search-p (and howm-title-from-search

647

(stringp search-str)))

648

(s (cond ((or title-p content-p) (buffer-substring-no-properties beg

649

end))

650

(search-p search-str))))

651

(cond ((null s) (cons "" ""))

652

((eq content-p t) (cons "" s))

653

((or title-p search-p) (cons s ""))

654

(content-p (cons "" s))

655

(t (cons "" ""))))))

656

657

(defun howm-create-here (&optional which-template)

658

(interactive "p")

659

(howm-create which-template t))

660

661

(defun howm-create-file-with-title (title &optional

662

which-template not-use-file here content)

663

(let ((b (current-buffer)))

664

(when (not here)

665

(howm-create-file))

666

(cond ((howm-buffer-empty-p) nil)

667

((and here howm-create-here-just) (beginning-of-line))

668

(t (howm-create-newline)))

669

(let ((p (point))

670

(insert-f (lambda (switch)

671

(howm-insert-template (if switch title "")

672

b which-template (not switch))))

673

(use-file (not not-use-file)))

674

;; second candidate which appears when undo is called

675

(let ((end (funcall insert-f not-use-file)))

676

(save-excursion

677

(goto-char end)

678

(insert (or content "")))

679

(undo-boundary)

680

(delete-region p end))

681

(funcall insert-f use-file))

682

(howm-set-mode)

683

(run-hooks 'howm-create-hook)))

684

685

(defun howm-create-newline ()

686

(widen)

687

(if howm-prepend

688

(howm-create-newline-prepend)

689

(howm-create-newline-append)))

690

(defun howm-create-newline-prepend ()

691

(goto-char (point-min)))

692

(defun howm-create-newline-append ()

693

(goto-char (point-max))

694

(delete-blank-lines)

695

(when (not (= (line-beginning-position) (point))) ;; not empty line

696

(insert "\n"))

697

(insert "\n"))

698

699

(defun howm-insert-template (title &optional

700

previous-buffer which-template not-use-file)

701

(let* ((beg (point))

702

(f (buffer-file-name previous-buffer))

703

(af (and f (howm-abbreviate-file-name f))))

704

(insert (howm-template-string which-template previous-buffer))

705

(let* ((date (format-time-string howm-template-date-format))

706

(use-file (not not-use-file))

707

(file (cond ((not use-file) "")

708

((null f) "")

709

((string= f (buffer-file-name)) "")

710

(t (format howm-template-file-format af)))))

711

(let ((arg `((title . ,title) (date . ,date) (file . ,file)))

712

(end (point-marker)))

713

(howm-replace howm-template-rules arg beg end)

714

end))))

715

716

(defvar howm-template-receive-buffer t

717

"Non nil if howm-template should receive previous-buffer

718

when howm-template is a function.

719

Set this option to nil if backward compatibility with howm-1.2.4 or earlier

720

is necessary.")

721

722

(defun howm-template-string (which-template previous-buffer)

723

;; which-template should be 1, 2, 3, ...

724

(setq which-template (or which-template 1))

725

(cond ((stringp howm-template) howm-template)

726

((listp howm-template) (nth (- which-template 1) howm-template))

727

((functionp howm-template) (let ((args (if howm-template-receive-buffer

728

(list which-template

729

previous-buffer)

730

(list which-template))))

731

(apply howm-template args)))))

732

733

(defun howm-replace (rules arg &optional beg end)

734

(mapc (lambda (pair)

735

(let ((spell (car pair))

736

(disp-f (cdr pair)))

737

(goto-char (or beg (point-min)))

738

(while (re-search-forward spell end t)

739

(delete-region (match-beginning 0) (match-end 0))

740

(funcall disp-f arg))))

741

rules))

742

743

;; Use dynamic bindings dirtily!

744

(defun howm-template-title (arg)

745

(insert (cdr (assoc 'title arg))))

746

(defun howm-template-date (arg)

747

(insert (cdr (assoc 'date arg))))

748

(defun howm-template-previous-file (arg)

749

(insert (cdr (assoc 'file arg))))

750

(defun howm-template-cursor (arg)) ;; do nothing

751

752

(defun howm-dup ()

753

(interactive)

754

(let* ((r (howm-view-paragraph-region))

755

(s (buffer-substring-no-properties (car r) (second r))))

756

(howm-create-file)

757

(howm-set-mode)

758

(insert "\n" s)))

759

760

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

761

;; Keyword

762

763

(defun howm-completing-read-keyword ()

764

(message "Scanning...")

765

(let* ((kl (howm-keyword-list))

766

(table (mapcar #'list kl))

767

(completion-ignore-case howm-keyword-case-fold-search))

768

(completing-read "Keyword: " table)))

769

770

(defun howm-insert-keyword ()

771

(interactive)

772

(insert (howm-completing-read-keyword)))

773

774

(defun howm-keyword-to-kill-ring (&optional filename-p)

775

(interactive "P")

776

(let ((title (howm-title-at-current-point filename-p)))

777

(if title

778

(howm-string-to-kill-ring title)

779

(error "No keyword."))))

780

781

(defun howm-title-at-current-point (&optional filename-p

782

title-regexp title-regexp-pos)

783

(let ((reg (or title-regexp howm-view-title-regexp))

784

(pos (or title-regexp-pos howm-view-title-regexp-pos)))

785

(save-excursion

786

(end-of-line)

787

(cond ((and (not filename-p)

788

(re-search-backward reg nil t))

789

(match-string-no-properties pos))

790

((buffer-file-name)

791

(howm-abbreviate-file-name (buffer-file-name)))

792

(t nil)))))

793

794

(defun howm-string-to-kill-ring (str)

795

(if str

796

(progn

797

(kill-new str)

798

(message "%s" str))

799

(error "Empty.")))

800

801

(defun howm-keyword-for-comefrom ()

802

(save-excursion

803

(goto-char (point-min))

804

(let ((keyword-list nil))

805

(while (re-search-forward howm-keyword-regexp nil t)

806

(setq keyword-list

807

(cons (match-string-no-properties howm-keyword-regexp-pos)

808

keyword-list)))

809

(reverse keyword-list))))

810

811

(defun howm-keyword-list ()

812

(let ((sep (format "[\n%s]" (or howm-keyword-list-alias-sep ""))))

813

(with-current-buffer (howm-keyword-buffer)

814

(delete ""

815

(split-string (buffer-substring (point-min) (point-max)) sep)))))

816

817

(defun howm-keyword-add (keyword-list)

818

(interactive "sKeyword: ")

819

(setq keyword-list (if (stringp keyword-list)

820

(list keyword-list)

821

keyword-list))

822

(save-excursion

823

(set-buffer (howm-keyword-buffer))

824

(goto-char (point-max))

825

(mapc (lambda (k)

826

(when (howm-keyword-new-p k)

827

(insert k "\n")))

828

keyword-list)

829

(when (buffer-file-name)

830

(howm-basic-save-buffer))

831

))

832

833

(defun howm-keyword-new-p (str)

834

(save-excursion

835

(let ((r (format "^%s$" (regexp-quote str)))

836

(case-fold-search howm-keyword-case-fold-search))

837

(goto-char (point-min))

838

(not (re-search-forward r nil t)))))

839

840

(defun howm-support-aliases-p ()

841

howm-keyword-list-alias-sep)

842

(defun howm-aliases ()

843

(if (howm-support-aliases-p)

844

(howm-read-aliases)

845

nil))

846

(defun howm-read-aliases ()

847

(with-current-buffer (howm-keyword-buffer)

848

(save-excursion

849

(let ((ans nil))

850

(goto-char (point-min))

851

(while (search-forward howm-keyword-list-alias-sep nil t)

852

(let ((line (buffer-substring-no-properties (line-beginning-position)

853

(line-end-position))))

854

(setq ans

855

(cons (split-string line howm-keyword-list-alias-sep) ans))

856

(end-of-line)))

857

ans))))

858

859

(defun howm-expand-aliases-recursively (keyword aliases)

860

(let ((keys (list keyword))

861

(prev nil))

862

(flet ((expand (keys)

863

(sort (howm-cl-remove-duplicates

864

(howm-cl-mapcan (lambda (k)

865

(howm-cl-mapcan

866

(lambda (a) (if (member k a)

867

(copy-list a)

868

nil))

869

aliases))

870

keys) :test #'string=)

871

#'string<)))

872

(while (not (equal prev keys))

873

(setq prev keys)

874

(setq keys (expand keys))))

875

keys))

876

(assert (equal (howm-expand-aliases-recursively "a"

877

'(("d" "e" "f") ("a" "b" "c")))

878

'("a" "b" "c")))

879

(assert (equal (howm-expand-aliases-recursively "a"

880

'(("d" "e" "b") ("a" "b" "c")))

881

'("a" "b" "c" "d" "e")))

882

883

(defun howm-keyword-aliases (keyword)

884

"List of strings which are equivalent to KEYWORD.

885

KEYWORD itself is always at the head of the returneded list.

886

"

887

(let* ((aliases (howm-aliases))

888

(equiv (if howm-keyword-aliases-recursive

889

(howm-expand-aliases-recursively keyword aliases)

890

(howm-cl-remove-duplicates

891

(apply #'append

892

(howm-cl-remove-if-not (lambda (a) (member keyword a))

893

aliases))))))

894

(if (null equiv)

895

keyword

896

(cons keyword (remove keyword equiv)))))

897

898

(defun howm-keyword-search (keyword &optional create-p open-unique-p)

899

(howm-message-time "key-search"

900

(howm-set-command 'howm-keyword-search)

901

(howm-keyword-search-subr keyword create-p open-unique-p)))

902

903

(defun howm-keyword-search-subr (keyword create-p open-unique-p)

904

(let* ((wconf (current-window-configuration))

905

(aliases (if (howm-support-aliases-p)

906

(howm-keyword-aliases keyword)

907

keyword))

908

(menu-p (howm-menu-keyword-p keyword))

909

(comefrom-regexp (if menu-p

910

nil

911

(howm-make-keyword-regexp2 aliases)))

912

(found (let ((howm-search-other-dir (if menu-p

913

nil

914

howm-search-other-dir))

915

(*howm-view-force-case-fold-search* howm-keyword-case-fold-search)) ;; dirty!

916

(howm-call-view-search aliases t)))

917

;; code for <http://pc8.2ch.net/test/read.cgi/unix/1077881095/823>.

918

;; but this change is canceled; I'll try more fundamental fix. [2005-11-04]

919

;; (if open-unique-p

920

;; (let ((r (concat "^" (regexp-quote keyword) "$")))

921

;; (howm-call-view-search r nil))

922

;; (howm-call-view-search aliases t))))

923

(matched (and found (howm-list-normalize aliases comefrom-regexp t)))

924

(keyword-matched (member 'keyword matched))

925

(file-matched (member 'file matched))

926

(title (howm-make-keyword-string keyword)))

927

;; main processing (clean me!) [2003-12-01]

928

(cond

929

;; for %foo%

930

((and menu-p keyword-matched)

931

(howm-keyword-search-open-menu keyword wconf))

932

;; for [[foo]]

933

((and create-p (not keyword-matched))

934

(howm-keyword-search-create title))

935

;; open if unique match

936

((and open-unique-p (howm-single-element-p (howm-view-item-list)))

937

(howm-keyword-search-open-unique wconf))

938

;; show title

939

((and found

940

(howm-list-title-p)

941

(not (and file-matched howm-inhibit-title-file-match)))

942

(howm-list-title)))

943

;; record history

944

(when (not menu-p)

945

(howm-write-history keyword))

946

;; return information

947

`((menu-p . ,menu-p)

948

(found . ,found)

949

(matched . ,matched)

950

(keyword-matched . ,keyword-matched)

951

(create-p . ,create-p))

952

))

953

954

(defun howm-keyword-search-open-menu (keyword wconf)

955

"Open KEYWORD as menu."

956

;; dirty. peeking howm-view.el

957

(let* ((item (car (howm-view-item-list)))

958

(fname (howm-view-item-filename item))

959

(place (howm-view-item-place item)))

960

(howm-view-kill-buffer)

961

(set-window-configuration wconf)

962

(howm-menu-open fname place

963

(howm-menu-name keyword))))

964

965

(defun howm-keyword-search-create (title)

966

"create new memo <<< TITLE."

967

(howm-view-kill-buffer)

968

(howm-create-file-with-title title)

969

(message "New keyword."))

970

971

(defun howm-keyword-search-open-unique (wconf)

972

"Open unique match."

973

;; dirty. peeking howm-view.el

974

(howm-view-summary-open)

975

(let ((b (current-buffer)))

976

(set-window-configuration wconf)

977

(switch-to-buffer b)))

978

979

;; (defvar *howm-keyword-buffer* nil) ;; for internal use

980

(defun howm-keyword-for-goto ()

981

(save-excursion

982

(let ((keys (howm-keyword-list))

983

(case-fold-search howm-keyword-case-fold-search))

984

(sort (howm-cl-mapcan (lambda (k)

985

(goto-char (point-min))

986

(if (search-forward k nil 'noerr)

987

(list k)

988

nil))

989

keys)

990

(lambda (x y)

991

(> (length x) (length y)))))))

992

993

(defun howm-keyword-add-current-buffer ()

994

(save-excursion

995

(goto-char (point-min))

996

(let ((m (current-message))

997

(keyword-list nil))

998

(while (re-search-forward howm-keyword-regexp nil t)

999

(let ((key-str (if howm-keyword-list-alias-sep

1000

(mapconcat #'identity

1001

(howm-keyword-read)

1002

howm-keyword-list-alias-sep)

1003

(match-string-no-properties howm-keyword-regexp-pos))))

1004

(setq keyword-list (cons key-str keyword-list))))

1005

(howm-keyword-add keyword-list)

1006

(message "%s" m))))

1007

1008

(defun howm-keyword-read ()

1009

(let ((ks nil)

1010

(beg (line-beginning-position)))

1011

(end-of-line)

1012

(skip-chars-backward " ")

1013

(while (re-search-backward howm-keyword-regexp beg t)

1014

(setq ks (cons (match-string-no-properties howm-keyword-regexp-pos) ks))

1015

(skip-chars-backward " "))

1016

(end-of-line)

1017

ks))

1018

1019

;; (defun howm-keyword-read ()

1020

;; (prog1

1021

;; (howm-keyword-read-string (buffer-substring-no-properties

1022

;; (line-beginning-position)

1023

;; (line-end-position)))

1024

;; (end-of-line)))

1025

1026

;; (defun howm-keyword-read-string (str)

1027

;; (with-temp-buffer

1028

;; (insert str)

1029

;; (goto-char (point-max))

1030

;; (let ((ans nil))

1031

;; (while (re-search-backward howm-keyword-regexp nil t)

1032

;; (let* ((mbeg (match-beginning 0))

1033

;; (key (match-string-no-properties howm-keyword-regexp-pos)))

1034

;; (setq ans (cons key ans))

1035

;; (delete-region mbeg (point-max))

1036

;; (skip-chars-backward " ")

1037

;; (delete-region (point) (point-max))))

1038

;; ans)))

1039

1040

(provide 'howm-mode)

1041

1042

;;; howm-mode.el ends here