~khiker/+junk/icomp : revision 1

1

;;; icomp.el --- inline completion functions for emacs

2

3

4

5

;; Author: khiker <khiker+elisp@gmail.com>

6

;; plus <MLB33828@nifty.com>

7

8

;; Keywords: dabbrev lisp info completion inline

9

10

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

11

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

12

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

13

;; any later version.

14

15

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

16

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

17

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

18

;; GNU General Public License for more details.

19

20

;; You should have received a copy of the GNU General Public License

21

;; along with GNU Emacs; see the file COPYING. If not, write to

22

;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,

23

;; Boston, MA 02110-1301, USA.

24

25

;;; Commentary:

26

27

;; inline completion for multiple selection.

28

;; This package tested on Emacs 22 and Emacs 23.0.50.2.

29

30

;;; Installation:

31

32

;; Put this file into your load-path, and,

33

;; add following line to your .emacs.

34

;;

35

;; (require 'icomp)

36

;; (global-set-key "\M-/" 'icomp-dabbrev-expand)

37

;; (global-set-key (kbd "C-M-/") 'icomp-dabbrev-expanding)

38

;;

39

;; (add-hook

40

;; 'emacs-lisp-mode-hook

41

;; '(lambda()

42

;; (define-key emacs-lisp-mode-map "\C-\M-i" 'icomp-elisp-complete-symbol)

43

;; ;; continues version

44

;; ;; (define-key emacs-lisp-mode-map "\C-\M-i" 'icomp-elisp-completing-symbol)

45

;; ))

46

;;

47

;; (global-set-key "\C-\M-i" 'icomp-info-complete-symbol)

48

;; ;; continues version

49

;; ;; (global-set-key "\C-\M-i" 'icomp-info-completing-symbol)

50

;;

51

;; Please match key setting to your favor.

52

53

;;; Note:

54

55

;; following functions was remodeled by based on functions of SKK.

56

;;

57

;; icomp-in-minibuffer-p

58

;; icomp-show-tooltip

59

;; icomp-mouse-position

60

;; icomp-inline-show

61

;; icomp-inline-hide

62

;; icomp-inline-show-vertical

63

;;

64

;; skk.el --- Daredevil SKK (Simple Kana to Kanji conversion program)

65

;;

66

67

68

;;

69

;; -----

70

;;

71

;; and, multibyte treatment of icomp-dabbrev-expand was remodeled by

72

;; based on dabbrev-ja.el.

73

;;

74

;; dabbrev-ja.el

75

;;

76

77

78

;;; Code:

79

80

(require 'dabbrev)

81

(require 'info-look)

82

83

;; Variables:

84

85

(defconst icomp-version "0.0.10"

86

"icomp's version")

87

88

(defgroup icomp nil

89

"inline completion functions for emacs"

90

:tag "inline completion functions for emacs"

91

:group 'icomp)

92

93

(defcustom icomp-select-keys

94

'("a" "s" "d" "f" "j" "k" "l")

95

"*Key config for selecting options."

96

:type '(repeat string)

97

:group 'icomp)

98

99

(defcustom icomp-multi-selection-keys '("\M-/")

100

"*Key config for moving to multiple option displaying menu."

101

:type '(repeat string)

102

:group 'icomp)

103

104

(defcustom icomp-next-keys '("\M-/" " ")

105

"*Key config for moving to next complementarity list."

106

:type '(repeat string)

107

:group 'icomp)

108

109

(defcustom icomp-previous-keys '("x" "\177")

110

"*Key config for moving to previous complementarity list."

111

:type '(repeat string)

112

:group 'icomp)

113

114

(defcustom icomp-vinline-select-next-key '("\C-n")

115

"*In vertical inline, the key that selects next one."

116

:type '(repeat string)

117

:group 'icomp)

118

119

(defcustom icomp-vinline-select-previous-key '("\C-p")

120

"*In vertical inline, the key that selects previous one."

121

:type '(repeat string)

122

:group 'icomp)

123

124

(defcustom icomp-vinline-select-return-key '("\C-m" [(retrun)])

125

"*In vertical inline, the key that insert selected one."

126

:type '(repeat string)

127

:group 'icomp)

128

129

(defcustom icomp-tooltip-timeout 2000

130

"*Seconds for displaying tooltip."

131

:type 'number

132

:group 'icomp)

133

134

(defcustom icomp-tooltip-params

135

'((foreground-color . "white")

136

(background-color . "NavyBlue")

137

(border-color . "blue"))

138

"*Face config for tooltip."

139

:type 'boolean

140

:group 'icomp)

141

142

(defface icomp-highlight-inline

143

'((((class color) (background dark))

144

(:foreground "white" :background "NavyBlue" :bold t))

145

(((class color) (background light))

146

(:foreground "white" :background "NavyBlue" :bold t))

147

(t (:bold t)))

148

"face of icomp-highlight-face and icomp-inline-show-face."

149

:group 'icomp)

150

151

(defface icomp-highlight-inline-selected

152

'((((class color) (background dark))

153

(:foreground "white" :background "purple" :bold t))

154

(((class color) (background light))

155

(:foreground "white" :background "purple" :bold t))

156

(t (:bold t)))

157

"face of icomp-vinline-select-face."

158

:group 'icomp)

159

160

(defcustom icomp-highlight-face 'icomp-highlight-inline

161

"*Face to highlight frist time expanded string."

162

:type 'face

163

:group 'icomp)

164

165

(defcustom icomp-inline-show-face 'icomp-highlight-inline

166

"*A Variable to appoint a face when display a option in inline.

167

By skk-inline-show-face of SKK."

168

:type '(radio (face :tag "Specify face")

169

(const :tag "Use default face attribute of candidate string."))

170

:group 'icomp)

171

172

(defcustom icomp-vinline-select-face 'icomp-highlight-inline-selected

173

"*In vertical inline, The face that highlights a selected line."

174

:type '(radio (face :tag "Specify face")

175

(const :tag "Use default face attribute of candidate string."))

176

:group 'icomp)

177

178

(defcustom icomp-display-style 'vertical

179

"*displaying style for multiple selection menu.

180

---------------------------------

181

| vertical|vertical inline show|

182

| inline| normal inline show|

183

|minibuffer| minibuffer show|

184

| tooltip| tooltip show|

185

| t| normal inline show|

186

| nil| normal inline show|

187

---------------------------------

188

Defualt is vertical inline."

189

:type '(choice (const :tag "minibuffer" minibuffer)

190

(const :tag "inline" inline)

191

(const :tag "vertical inline" vertical)

192

(const :tag "tooltip" tooltip))

193

:group 'icomp)

194

195

(defcustom icomp-display-no-candidate-message t

196

"*Non-nil means displaying message when `icomp-read' could not

197

found completion candidate."

198

:type 'boolean

199

:group 'icomp)

200

201

(defcustom icomp-tags-exts '("c" "h" "C" "H" "cpp" "CPP" "hpp" "HPP"

202

"html" "htm" "tex" "el" "l" "lua" "lisp"

203

"pl" "php" "ps" "py" "scm" "asm")

204

"*"

205

:type '(repeat string)

206

:group 'icomp)

207

208

(defvar icomp-inline-overlays nil)

209

(defvar icomp-last-key nil)

210

211

212

;; Macros:

213

214

(defmacro icomp-dabbrev-ja (&rest body)

215

"dabbrev for multibyte words.

216

From http://namazu.org/~tsuchiya/elisp/dabbrev-ja.e"

217

`(let* ((dabbrev--abbrev-char-regexp

218

(let ((c (char-category-set (char-before))))

219

(cond

220

((aref c ?a) "[-_A-Za-z0-9]") ; ASCII

221

((aref c ?j) ; Japanese

222

(cond

223

((aref c ?K) "\\cK") ; katakana

224

((aref c ?A) "\\cA") ; 2byte alphanumeric

225

((aref c ?H) "\\cH") ; hiragana

226

((aref c ?C) "\\cC") ; kanji

227

(t "\\cj")))

228

((aref c ?k) "\\ck") ; hankaku-kana

229

((aref c ?r) "\\cr") ; Japanese roman ?

230

(t dabbrev-abbrev-char-regexp)))))

231

,@body))

232

233

234

;; Functions:

235

236

(defun icomp-dabbrev-expand ()

237

"The function that do dynamic abbrev expansion for multiple selection.

238

239

When you executed the function, the function behaves as well as normal

240

dabbrev-expand. It complement only one candidate.

241

If that candidate is not something that you want, It displays multiple

242

selection by pushing `M-/' or key that launch icomp-dabbrev-expand.

243

244

The abbrev displayed at a time is three in default.

245

This number is controled by `icomp-select-keys'.

246

247

style format is prepared three types.

248

- minibuffer

249

- inline

250

- tooltip

251

if variable `icomp-display-style' is non-nil,

252

display by vertical inline.

253

Nil means displaying inline.

254

If variable is nil, And point is minibuffer, display by minibuffer."

255

(interactive)

256

(dabbrev--reset-global-variables)

257

(icomp-dabbrev-ja

258

(let* ((ex-target (dabbrev--abbrev-at-point))

259

(expands (list (dabbrev--find-expansion ex-target

260

0

261

dabbrev-case-fold-search))))

262

(icomp-read1 ex-target

263

'(lambda (ex-target num alist &optional max)

264

(when (= num 0)

265

(setq expands

266

(nreverse

267

(cons (car expands)

268

(nreverse

269

(dabbrev--find-all-expansions ex-target

270

nil))))))

271

(icomp-get-candidates num

272

alist

273

(icomp-get-completions ex-target

274

expands)))))))

275

276

(defun icomp-dabbrev-expanding ()

277

"execute dabbrev-expnad in succession.

278

see also `icomp-completing'."

279

(interactive)

280

(icomp-completing '(lambda ()

281

(dabbrev--reset-global-variables)

282

(icomp-dabbrev-ja (dabbrev--abbrev-at-point)))

283

'(lambda (target num alist &optional max)

284

(icomp-dabbrev-ja

285

(funcall 'icomp-dabbrev-get-candidates

286

target

287

num

288

alist

289

max)))))

290

291

(defun icomp-elisp-complete-symbol ()

292

"The function that do lisp complete symbol for multiple selection.

293

also see `icomp-dabbrev-expand'."

294

(interactive)

295

(let* ((el-target (icomp-elisp-get-target))

296

(el-symbols (icomp-elisp-get-completions el-target)))

297

(icomp-read1 el-target

298

'(lambda (el-target num alist &optional max)

299

(icomp-get-candidates num

300

alist

301

(icomp-get-completions el-target

302

el-symbols))))))

303

304

(defun icomp-elisp-completing-symbol ()

305

"execute lisp-complete-symbol in succession."

306

(interactive)

307

(let* ((el-target (icomp-elisp-get-target))

308

(el-symbols (icomp-elisp-get-completions el-target)))

309

(icomp-completing 'icomp-elisp-get-target

310

'(lambda (el-target num alist &optional max)

311

(when (null alist)

312

;; Since predicate had been already executed,

313

;; so it is not necessary here.

314

(setq el-symbols

315

(icomp-get-completions el-target

316

el-symbols)))

317

(icomp-get-candidates num

318

alist

319

el-symbols

320

max)))))

321

322

(defun icomp-info-complete-symbol ()

323

"The function that do info complete symbol for multiple selection.

324

also see `icomp-dabbrev-expand'."

325

(interactive)

326

(let ((start (point))

327

(mode (info-lookup-select-mode))

328

info-target info-symbols)

329

(when mode

330

(setq info-target (info-lookup-guess-default* 'symbol mode))

331

(setq info-symbols (icomp-get-completions info-target

332

(info-lookup->completions

333

'symbol

334

(info-lookup-select-mode))))

335

;; adjust point

336

(end-of-line)

337

(while (and (search-backward info-target nil t)

338

(< start (point))))

339

(goto-char (+ (point) (length info-target)))

340

(icomp-read1 info-target '(lambda (info-target num alist &optional max)

341

(icomp-get-candidates num

342

alist

343

info-symbols))))))

344

345

(defun icomp-info-completing-symbol ()

346

"execute info-complete-symbol in succession."

347

(interactive)

348

(let ((start (point))

349

(mode (info-lookup-select-mode))

350

info-target info-symbols)

351

(when mode

352

(setq info-target (info-lookup-guess-default* 'symbol mode))

353

;; adjust point

354

(end-of-line)

355

(while (and (search-backward info-target nil t)

356

(< start (point))))

357

(goto-char (+ (point) (length info-target)))

358

(icomp-completing '(lambda ()

359

(let ((mode (info-lookup-select-mode)))

360

(setq info-target

361

(info-lookup-guess-default* 'symbol mode))))

362

'(lambda (info-target num alist &optional max)

363

(when (null alist)

364

(setq info-symbols

365

(icomp-get-completions info-target

366

(info-lookup->completions

367

'symbol

368

(info-lookup-select-mode)))))

369

(icomp-get-candidates num

370

alist

371

info-symbols))))))

372

373

(defun icomp-tags-complete-symbol ()

374

"The function that do complete-tag for multiple selection.

375

also see `icomp-dabbrev-expand'."

376

(interactive)

377

(let* ((tag-target (funcall (or find-tag-default-function

378

(get major-mode 'find-tag-default-function)

379

'find-tag-default)))

380

(tag-symbols (icomp-get-completions tag-target (tags-completion-table))))

381

;; move point to end point of target.

382

(search-backward tag-target)

383

(forward-char (length tag-target))

384

;; load tags automatically.

385

(icomp-tags-load)

386

(icomp-read1 tag-target '(lambda (tag-target num alist &optional max)

387

(icomp-get-candidates num

388

alist

389

tag-symbols)))))

390

391

(defun icomp-tags-completing-symbol ()

392

"execute icomp-tags-complete-symbol in succession."

393

(interactive)

394

(let* ((tag-target (funcall (or find-tag-default-function

395

(get major-mode 'find-tag-default-function)

396

'find-tag-default)))

397

(tag-symbols (icomp-get-completions tag-target (tags-completion-table))))

398

;; move point to end point of target.

399

(search-backward tag-target)

400

(forward-char (length tag-target))

401

;; load tags automatically.

402

(icomp-tags-load)

403

(icomp-completing '(lambda ()

404

(funcall (or find-tag-default-function

405

(get major-mode

406

'find-tag-default-function)

407

'find-tag-default)))

408

'(lambda (tag-target num alist &optional max)

409

(when (null alist)

410

(setq tag-symbols

411

(icomp-get-completions tag-target

412

tag-symbols)))

413

(icomp-get-candidates num

414

alist

415

tag-symbols)))))

416

417

(defun icomp-dabbrev-get-candidates (dtarget num alist &optional max)

418

"get new abbrevs. return list of abbrev."

419

(let ((len (if max max (length icomp-select-keys)))

420

(dtarget (if (and dtarget (stringp dtarget))

421

dtarget

422

(dabbrev--abbrev-at-point)))

423

(i 0)

424

abbrev abbrev-list)

425

(if (null (nth num alist))

426

(while (and (> len i)

427

(setq abbrev

428

(dabbrev--find-expansion

429

dtarget 0 dabbrev-case-fold-search)))

430

(add-to-list 'abbrev-list abbrev t)

431

(setq i (1+ i)))

432

(setq abbrev-list (nth num alist)))

433

abbrev-list))

434

435

(defun icomp-elisp-get-target ()

436

"get target for emacs lisp completion."

437

(let ((end (point))

438

(beg (save-excursion

439

(with-syntax-table emacs-lisp-mode-syntax-table

440

(backward-sexp 1)

441

(while (= (char-syntax (following-char))

442

?\')

443

(forward-char 1))

444

(point)))))

445

(buffer-substring beg end)))

446

447

(defun icomp-elisp-get-completions (etarget)

448

"return list of elisp symbol."

449

(let* ((predicate (if (eq (char-after (1- (- (point)

450

(string-width etarget))))

451

?\()

452

'fboundp

453

(function (lambda (sym)

454

(or (boundp sym) (fboundp sym)

455

(symbol-plist sym))))))

456

;; get candidates from obarray using function mapatoms.

457

;; lambda expression divides symbols to function and variables.

458

;; this mapatoms expression returns list of completion candidates.

459

(completions (let ((tlen (length etarget))

460

tstr tlist)

461

(mapatoms '(lambda (x)

462

(setq tstr (format "%s" x))

463

(when (and (funcall predicate x)

464

(>= (length tstr) tlen)

465

(string= etarget

466

(substring tstr

467

0

468

tlen)))

469

(setq tlist (cons x tlist)))))

470

tlist)))

471

;; [issue] Had better sort a list?

472

(nreverse completions)))

473

474

(defun icomp-tags-load ()

475

"load TAGS file."

476

(let ((tag-file (concat default-directory "TAGS"))

477

(dir-files (directory-files default-directory))

478

(regex '())

479

tag-target)

480

(dolist (i dir-files)

481

(when (and (member (file-name-extension i) icomp-tags-exts)

482

(not (member (file-name-extension i) regex)))

483

(setq regex (cons (file-name-extension i) regex))))

484

(setq tag-target (mapconcat '(lambda (x) (concat " *." x)) regex ""))

485

;; Should i consider update?

486

(when (not (file-exists-p tag-file))

487

(shell-command (concat "etags" tag-target " -o TAGS 2>/dev/null")))

488

(visit-tags-table tag-file)))

489

490

(defun icomp-get-leaves (alist)

491

"count leaves of alist."

492

(eval (cons '+ (mapcar '(lambda (x) (length x)) alist))))

493

494

(defun icomp-get-completions (comp-target completions &optional predicate)

495

"return list of symbol."

496

(let ((tlen (length comp-target))

497

tlist)

498

(mapc '(lambda (x)

499

(when (consp x)

500

(setq x (car x)))

501

(when (not (stringp x))

502

(setq x (format "%s" x)))

503

(when (and (>= (length x) tlen)

504

(string= comp-target (substring x 0 tlen))

505

(if predicate (funcall predicate x) t))

506

(setq tlist (cons x tlist))))

507

completions)

508

tlist))

509

510

(defun icomp-get-candidates (num alist completions &optional max)

511

"get new candidates from completions. return length of icomp-select-keys

512

or num of max."

513

(let ((len (if max max (length icomp-select-keys)))

514

(candidate-list (nth num alist))

515

candidates)

516

(when (null candidate-list)

517

(let* ((leaves (icomp-get-leaves alist))

518

(completions (nthcdr leaves completions)))

519

(setq candidate-list nil)

520

(when completions

521

(dotimes (i len)

522

(when (car completions)

523

(setq candidate-list (cons (car completions) candidate-list))

524

(setq completions (cdr completions))))))

525

(setq candidate-list (reverse candidate-list)))

526

candidate-list))

527

528

(defun icomp-read1 (target get-candidates)

529

"This function put up one candidate first, and next executes `icomp-read'.

530

531

Arguments:

532

`target' is completion target.

533

`get-candidates' is function that returns next candidates.

534

535

func's definition is following.

536

arguments for func.

537

- num: target number of alist.

538

- alist: associative arrangement.

539

- max(optional): max number of completion candidates.

540

For example:

541

(func 1 '((a) (b c d) (e f g))) returns (b c d)

542

(func 3 '((a) (b c d) (e f g))) returns next list of candidates."

543

(setq icomp-last-key nil) ; init last inputted last-key

544

(let* ((candidate (car (funcall get-candidates target 0 nil 1)))

545

(prompt "")

546

action overlay)

547

(cond

548

;; Expansion candidate found.

549

(candidate

550

;; insert candidate

551

(insert (substring candidate (length target)))

552

;; hightlight candidate

553

(setq overlay (make-overlay (- (point) (length candidate)) (point)))

554

(overlay-put overlay 'face icomp-highlight-face)

555

;; wait key input. and, record pushed key.

556

(setq action (read-key-sequence-vector prompt))

557

;; reset hightlight

558

(delete-overlay overlay)

559

;; record last-command-char

560

(setq icomp-last-key last-command-char)

561

(cond

562

((icomp-selection-keys-p action icomp-multi-selection-keys t)

563

;; reset candidate

564

(delete-char (- (length candidate)))

565

(insert target)

566

;; start multiple selection

567

(icomp-read target get-candidates 1 (list (list candidate))))

568

;; execute command that bound to pushed key.

569

(t

570

(icomp-do-last-command action))))

571

;; Expansion candidate *Not* found.

572

(t

573

(message "No expansion candidate for `%s' found" target)))))

574

575

(defun icomp-read (target get-candidates &optional num alist)

576

"The function that completes expansion candidates for

577

multiple selection.

578

579

argumets:

580

Explanation of `target' and `func' exist `icomp-read1'.

581

`num' and `alist' are only used by called by `icomp-read1'.

582

583

The candidate displayed at a time is seven in default.

584

This number is controled by `icomp-select-keys'.

585

586

show next candidates: M-/, space, or launched key.

587

show previous candidates: x or Backspace

588

close: C-g

589

590

style format is prepared three types.

591

- minibuffer

592

- inline

593

- tooltip

594

- vertical inline.

595

if variable `icomp-display-style' is non-nil, display by vertical inline.

596

Nil means displaying inline.

597

If variable is nil, And point is minibuffer, display by minibuffer."

598

;; when last-key is not registered, init it.

599

(when (null icomp-last-key)

600

(setq icomp-last-key last-command-char))

601

;; setting local variable

602

(let* ((num (if num num 0))

603

(vert (and (not (icomp-in-minibuffer-p))

604

(or (eq icomp-display-style 'vertical)

605

(eq icomp-display-style 'tooltip)

606

(eq icomp-display-style 't))))

607

candidate-list sel action prompt vtarget)

608

(while (> num -1)

609

;; initialize variables

610

(setq candidate-list (funcall get-candidates target num alist) ; get new candidates

611

sel (null candidate-list)

612

prompt ""

613

action nil)

614

;; case: do not display "couldn't get new candidate" message.

615

;; and, could not get new candidates.

616

(when (and (null candidate-list)

617

(null icomp-display-no-candidate-message)

618

alist)

619

(setq num (1- num)

620

candidate-list (funcall get-candidates target num alist)

621

sel (null candidate-list)))

622

;; set prompt

623

(let ((len (length candidate-list))

624

(tlist '())

625

str)

626

(dotimes (i len)

627

(setq tlist (cons (concat (nth (- len i 1) icomp-select-keys)

628

": "

629

(setq str

630

(nth (- len i 1) candidate-list)))

631

tlist)))

632

(setq prompt (mapconcat 'identity tlist (if vert "\n" " "))))

633

;; couldn't get new candidate

634

(when (and (null candidate-list) icomp-display-no-candidate-message)

635

(setq prompt " No expansion candidate. "))

636

;; create tooltip, overlay or minibuffer message

637

(cond

638

;; case: icomp-display-no-candidate-message => nil

639

;; search candidates on first time => nil

640

((string= prompt ""))

641

;; point in minibuffer

642

((or (icomp-in-minibuffer-p)

643

(eq icomp-display-style 'minibuffer))

644

(setq action (read-key-sequence-vector prompt)))

645

;; use tooltip

646

((eq icomp-display-style 'tooltip)

647

(let* ((P (icomp-mouse-position))

648

(frame (car P))

649

(x (cadr P))

650

(y (cddr P))

651

(oP (mouse-position))

652

(oframe (car oP))

653

;; unless mouse curosr is on the frame,

654

;; not be able to get original mouse position.

655

;; this line is the countermeasure.

656

(ox (or (cadr oP) 0))

657

(oy (or (cddr oP) 15)))

658

;; move mouse position.

659

(set-mouse-position frame x y)

660

(icomp-show-tooltip prompt)

661

(setq action (read-key-sequence-vector ""))

662

(tooltip-hide)

663

(set-mouse-position oframe ox oy)))

664

;; use vertical inline show

665

((eq icomp-display-style 'vertical)

666

(icomp-inline-show-vertical prompt icomp-inline-show-face vtarget)

667

(setq action (read-key-sequence-vector ""))

668

(icomp-inline-hide))

669

;; use inline show

670

(t

671

(icomp-inline-show prompt icomp-inline-show-face)

672

(setq action (read-key-sequence-vector ""))

673

(icomp-inline-hide)))

674

;; if icomp-display-no-candidate-message is non-nil, prompt is not "".

675

;; if icomp-display-no-candidate-message is nil,

676

;; there is possibility of "" in the prompt.

677

(when (not (string= prompt ""))

678

;; clear minibuffer

679

(message "")

680

(setq sel (length (member (string (aref action 0))

681

(reverse icomp-select-keys))))

682

;; if this time did not use cache, update alist.

683

(when (null (nth num alist))

684

(add-to-list 'alist candidate-list t)))

685

(cond

686

;; * features only vertical inline START

687

;; vinline highlight selection: next

688

((and (eq icomp-display-style 'vertical)

689

(icomp-selection-keys-p action icomp-vinline-select-next-key))

690

(cond

691

;; init

692

((null vtarget) (setq vtarget 0))

693

;; do nothing

694

((null candidate-list))

695

;; when vtarget is last one, display next candidates.

696

((and (= vtarget (1- (length (nth num alist))))

697

candidate-list)

698

(setq num (1+ num) vtarget 0))

699

(t

700

(setq vtarget (1+ vtarget)))))

701

;; vinline highlight selection: previous

702

((and (eq icomp-display-style 'vertical)

703

(icomp-selection-keys-p action icomp-vinline-select-previous-key))

704

(cond

705

;; init

706

((null vtarget) (setq vtarget (length icomp-select-keys)))

707

;; when vtarget is first one, display previsou candidates.

708

((= vtarget 0)

709

(when (> num 0)

710

(setq num (1- num))))

711

(t

712

(setq vtarget (1- vtarget)))))

713

;; vinline highlight selection: enter

714

((and (eq icomp-display-style 'vertical)

715

(icomp-selection-keys-p action icomp-vinline-select-return-key))

716

(when (and vtarget candidate-list)

717

(setq sel (1+ vtarget)))

718

(setq num -1))

719

;; * features only vertical inline END

720

;; next selection

721

((icomp-selection-keys-p action icomp-next-keys t)

722

(when candidate-list

723

(setq num (1+ num))))

724

;; previous selection

725

((icomp-selection-keys-p action icomp-previous-keys)

726

(when (> num 0)

727

(setq num (1- num))))

728

;; exit while loop

729

(t (setq num -1))))

730

;; why variables name is " *not* completed"

731

;; this reason is to specification of icomp-reading.

732

;; icomp-reading finished at time of the case of the

733

;; "can not get new candidates" or

734

;; the case of the "cat get new candidates and completed".

735

;; The reason is because I wanted to unify the cdr of these.

736

;; --

737

;; can not get new candidates => nil

738

;; cat get new candidates and completed => (alist nil)

739

;; cat get new candidates and not completed => (alist t)

740

(let ((not-completed t))

741

(cond

742

;; get no candidates.

743

((null action)

744

(message ""))

745

;; pushed a key except icomp-select-keys

746

((or (= sel 0) (> sel (length candidate-list)))

747

(icomp-do-last-command action))

748

(t

749

(setq not-completed nil)

750

;; insert selected string

751

(insert

752

(substring (nth (1- sel) candidate-list) (length target)))))

753

(if (and (= (length alist) 0) (null candidate-list))

754

nil

755

;; make values. cons alist and not-complete or not

756

(cons (if (listp alist) alist (list alist)) not-completed)))))

757

758

(defun icomp-completing (get-target get-candidates)

759

"The function that complete in succession.

760

761

If applied to either of the following, quit execution of a function.

762

763

1. execute completion.

764

2. buffer-file-name is changed.

765

3. original point > now point.

766

4. do not get new target of completion.

767

4. next completion target length < first completion target length.

768

5. target of completion changed.

769

6. the string between an original point and the current point has space or tab.

770

7. move another line.

771

8. can not get new candidates.

772

773

argumets:

774

`get-target' is function that returns next completion target.

775

`get-candidates': is function that returns next candidates.

776

777

execute of completion is upcase.

778

for example:

779

not a, s, d, f ... but A, S, D, F ...

780

781

if completion candidates is nothing, do not display message.

782

783

variable `icomp-next-keys' `icomp-previous-keys' is nil.

784

785

As known problem, if user uses vertical inline and completes C-n...C-m,

786

program continues displaying vertical inline."

787

(setq icomp-last-key nil)

788

(let* ((icomp-select-keys (mapcar 'upcase icomp-select-keys))

789

(icomp-display-no-candidate-message nil)

790

(icomp-next-keys nil)

791

(icomp-previous-keys nil)

792

(line (count-lines (point-min) (point)))

793

(buf (buffer-file-name))

794

(def-target (funcall get-target))

795

(word def-target)

796

(len (length def-target))

797

(op (point)))

798

(while (and (not (member (cond

799

((and last-input-char

800

(integerp last-input-char))

801

(char-to-string last-input-char))

802

(t

803

nil))

804

icomp-select-keys))

805

(string= buf (buffer-file-name))

806

(>= (point) op)

807

(setq word (funcall get-target)) ; get new target

808

(>= (length word) len)

809

(string= (substring word 0 len) def-target)

810

(not (string-match " \\| " ; should be a variable?

811

(buffer-substring-no-properties op (point))))

812

(= line (+ (count-lines (point-min) (point)) (if (bolp) 1 0)))

813

(cdr (icomp-read word get-candidates)))

814

(setq icomp-last-key nil))))

815

816

(defun icomp-selection-keys-p (action keys &optional last)

817

"Check whether these keys were pushed.

818

1. A key same as the key which you used to lauch icomp-read1 or icomp-read.

819

2. one of variables keys."

820

(when action

821

(not (not (memq (aref action 0)

822

(apply 'append

823

(when last

824

(list icomp-last-key))

825

(mapcar

826

(lambda (x)

827

(cond

828

((stringp x)

829

(listify-key-sequence x))

830

((numberp x)

831

(list x))

832

((listp x)

833

(list (event-convert-list x)))

834

((vectorp x)

835

(list (event-convert-list (aref x 0))))))

836

keys)))))))

837

838

(defun icomp-do-last-command (action)

839

"Execute command assigned to the key which you input."

840

(let ((last-command-char (aref action 0))

841

(command (key-binding action)))

842

(when command

843

(call-interactively command))

844

(message "")))

845

846

(defun icomp-in-minibuffer-p ()

847

"Check whether point is current-buffer or minibuffer.

848

by skk-in-minibuffer-p of SKK."

849

(eq (current-buffer) (window-buffer (minibuffer-window))))

850

851

(defun icomp-show-tooltip (text)

852

"Display tooltip.

853

by skk-tooltip-show-1 of SKK."

854

(condition-case error

855

(let ((params (copy-sequence tooltip-frame-parameters))

856

fg bg)

857

(if icomp-tooltip-params

858

;; tooltip display config for user

859

(dolist (cell icomp-tooltip-params)

860

(setq params (tooltip-set-param params

861

(car cell)

862

(cdr cell))))

863

;; set the default of tooltip

864

(setq fg (face-attribute 'tooltip :foreground))

865

(setq bg (face-attribute 'tooltip :background))

866

(when (stringp fg)

867

(setq params (tooltip-set-param params 'foreground-color fg))

868

(setq params (tooltip-set-param params 'border-color fg)))

869

(when (stringp bg)

870

(setq params (tooltip-set-param params 'background-color bg))))

871

(x-show-tip (propertize text 'face 'tooltip)

872

(selected-frame)

873

params

874

icomp-tooltip-timeout

875

tooltip-x-offset

876

tooltip-y-offset))

877

(error

878

(message "Error while displaying tooltip: %s" error)

879

(sit-for 1)

880

(message "%s" text))))

881

882

(defun icomp-mouse-position ()

883

"Return the position of point as (FRAME X . Y).

884

Analogous to mouse-position.

885

886

by skk-e21-mouse-position of SKK."

887

(let* ((w (selected-window))

888

(edges (window-edges w))

889

(list

890

(compute-motion

891

(max (window-start w) (point-min))

892

'(0 . 0)

893

(point)

894

(cons (window-width w) (window-height w))

895

(1- (window-width w))

896

(cons (window-hscroll w) 0)

897

w)))

898

(cons (selected-frame)

899

(cons (+ (car edges) (car (cdr list)))

900

(+ (car (cdr edges)) (car (cdr (cdr list))))))))

901

902

(defun icomp-inline-show (string face)

903

"Display string on inline by using overlay.

904

by skk-inline-show of SKK."

905

(icomp-inline-hide)

906

(unless (icomp-in-minibuffer-p)

907

(let (base-ol)

908

(setq base-ol (make-overlay (point) (point)))

909

(overlay-put base-ol

910

'after-string

911

(apply #'propertize string

912

(if face `(face ,face) nil)))

913

(setq icomp-inline-overlays (cons base-ol icomp-inline-overlays)))))

914

915

(defun icomp-inline-show-vertical (string face &optional target)

916

"Display string on vertical inline by using overlay.

917

by skk-inline-show-vertical of SKK."

918

(icomp-inline-hide)

919

(unless (icomp-in-minibuffer-p)

920

(let* ((margin 2)

921

(beg-col (current-column))

922

(candidates (split-string string "\n"))

923

(max-width (apply 'max (mapcar 'string-width candidates)))

924

(i 0)

925

bottom ol invisible)

926

;; first setting: ol

927

(setq ol (make-overlay (point) (1+ (point))))

928

(overlay-put ol 'after-string "")

929

(setq icomp-inline-overlays (cons ol icomp-inline-overlays))

930

(dolist (str candidates)

931

;; adjust string length

932

(setq str

933

(concat str (make-string (- max-width (string-width str)) ? )))

934

;; add face to candidate.

935

(when face

936

(setq str (propertize str 'face face)))

937

(when (and target (= i target))

938

(setq str (propertize str 'face icomp-vinline-select-face)))

939

(save-excursion

940

(setq bottom (not (and (= 0 (forward-line (1+ i))) (bolp))))

941

(end-of-line)

942

(cond

943

(bottom

944

(setq ol

945

(prog1 (car icomp-inline-overlays)

946

(setq icomp-inline-overlays (cdr icomp-inline-overlays))))

947

(setq str (concat (overlay-get ol 'after-string)

948

"\n" (make-string beg-col ? ) str)))

949

((> beg-col (current-column))

950

;; To adjust column number, add space.

951

(setq str (concat (make-string (- beg-col (current-column)) ? )

952

str)))

953

((= beg-col (current-column))) ; do nothing.

954

(t

955

;; move point to start point of overlay.

956

(while (and (not (bolp))

957

(< beg-col (current-column)))

958

(backward-char))

959

;; when far left of overlay overlap with multibyte char, do adjust.

960

(unless (= beg-col (current-column))

961

(setq str (concat (make-string (- beg-col (current-column)) ? )

962

str)))))

963

;; In this time, point is start point of overlay.

964

(unless bottom

965

(let ((ol-beg (point))

966

(insert-width (string-width str))

967

ol-width base-ol)

968

;; decide end point of overlay.

969

(unless (eolp)

970

(forward-char))

971

(while (and (not (eolp))

972

(< (setq ol-width (string-width

973

(buffer-substring

974

ol-beg (point))))

975

insert-width))

976

(forward-char))

977

;; when far right of overlay overlap with multibyte char, do adjust.

978

(when (and ol-width

979

(> ol-width insert-width))

980

(setq str (concat str

981

(make-string (- ol-width insert-width) ? ))))

982

(setq ol (make-overlay ol-beg (point)))

983

;; So as not succeed face of former text, make the overlay behind original.

984

(setq base-ol (make-overlay (point) (1+ (point))))

985

(overlay-put base-ol 'face 'default)

986

(setq icomp-inline-overlays (cons base-ol icomp-inline-overlays))

987

;; check visibility of candidate

988

(unless (pos-visible-in-window-p (point))

989

(setq invisible t)))))

990

(overlay-put ol 'invisible t)

991

(overlay-put ol 'after-string str)

992

(setq icomp-inline-overlays (cons ol icomp-inline-overlays))

993

(setq i (1+ i)))

994

;; adjusting display

995

(when (or invisible

996

(and bottom

997

(> (1+ (length icomp-select-keys))

998

(- (if (fboundp 'window-body-height)

999

(window-body-height)

1000

(- (window-height)

1001

(if mode-line-format 1 0)

1002

(if header-line-format 1 0)))

1003

(count-lines (window-start) (point))))))

1004

(recenter (- (1+ (length icomp-select-keys)))))

1005

(scroll-left (max 0

1006

(- (+ beg-col max-width 1)

1007

(window-width) (window-hscroll)))))))

1008

1009

(defun icomp-inline-hide ()

1010

"Delete overlay of icomp-inline-show.

1011

by skk-inline-hide of SKK."

1012

(when icomp-inline-overlays

1013

(dolist (ol icomp-inline-overlays)

1014

(delete-overlay ol))

1015

(setq icomp-inline-overlays nil)))

1016

1017

(provide 'icomp)

1018

1019

;; Local Variables:

1020

;; Coding: iso-2022-7bit

1021

;; End:

1022

1023

;; icomp.el ends here